[编程交流] 有人能检查这个Lisp程序吗

;;;compiled from various lisps. Thanks to all Developers.
;;;compiled by Balaji Subramanian VSL Middle East balaji.indian@yahoo.com
;;;Version 1.0 Inner Tenndon Z-Values Created.
;;;VERSION 1.1 Z-VALUES moved and duplicate lines deleted.
;;;VERSION 1.2 Z-VALUES ALIGNED AT EQUAL SPACING
(defun *error* (errmsg)
 (princ "\nAn error has occurred in the programme. ")
 (terpri)
 (prompt errmsg)
 (princ)
)
(defun trap1 (errmsg)                                                ;define function
(command "u" "b")                                        ;undo back
(setvar "osmode" oldsnap)                                ;restore variables
(setvar "clayer" oldlayer)
(setvar "cmdecho" oldecho)
(setq *error* temperr)                                        ;restore *error*
(prompt "\nResetting System Variables ")                ;inform user
  (princ)
)
(defun texAlign (item /)
   (if(= daly:Direct "Y")
     (progn
         (setq disDelta(- disDelta daly:strDis))                        ; end setq 
     (vla-put-Alignment (car str) tAlignment) 
     (cond 
  ((= tAlignment 0) 
     (vla-put-InsertionPoint (car str) 
       (vlax-3D-Point(car insPoint) 
         (+ disDelta(cadr insPoint))(nth 2 insPoint))) 
   ) 
  ((member tAlignment '(1 2 4 6 7 8 9 10 11 12 13 14)) 
     (vla-put-TextAlignmentPoint (car str) 
       (vlax-3D-Point(car tAlignPt) 
         (+ disDelta(cadr tAlignPt))(nth 2 tAlignPt))) 
   ) 
  ((member tAlignment '(3 5)) 
   (princ "\nCan't align string with Aligned or Fit alignment ") 
   ) 
  )                                                                        ; end cond
)                                                                ; end progn
     (progn
     (setq disDelta(- disDelta daly:strDis))                                ; end setq 
     (vla-put-Alignment (car str) tAlignment) 
     (cond 
  ((= tAlignment 0) 
     (vla-put-InsertionPoint (car str) 
       (vlax-3D-Point(-(car insPoint)disDelta)
         (cadr insPoint)(nth 2 insPoint))) 
   ) 
  ((member tAlignment '(1 2 4 6 7 8 9 10 11 12 13 14)) 
     (vla-put-TextAlignmentPoint (car str) 
       (vlax-3D-Point(-(car tAlignPt)disDelta)
         (cadr tAlignPt)(nth 2 tAlignPt))) 
   ) 
  ((member tAlignment '(3 5)) 
   (princ "\nCan't align string with Aligned or Fit alignment ") 
   ) 
  )                                                                        ; end cond
     )                                                                        ; end progn
   )                                                                        ; end if
   )                                                                        ; end of texAlign
(defun c:iz ()
 (vl-load-com)
 
         (setq temperr *error*)                                        ;store *error*
(setq *error* trap1)                                        ;re-assign *error*
(setq oldecho (getvar "cmdecho"))                        ;store variables
(setq oldlayer (getvar "clayer"))
(setq oldsnap (getvar "osmode"))
(setvar "cmdecho" 0)                                        ;reset variables
(setvar "osmode" 32)
(command "undo" "m")
 
 (command "layer" "make" "Z-VALUES" "color" "5" "" "")
 (princ "\nSelect Outer Tendon: ")
 (setq ten2 (ssget))
 (princ "\nSelect Inner Tendon: ")
 (setq ten1 (ssget))
 (princ "\n>> Select Points >>")
 (setvar "osmode" 0)
 (if (setq i -1 ss (ssget '((0 . "POINT"))))                                                ;IF STARTS HERE
   
   (if (and (setq ent (car (entsel "\nSelect Reference Line: ")))
            (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,CIRCLE,ELLIPSE,ARC"))
       (while (setq pt (ssname ss (setq i (1+ i))))
                         (setq p2 (vlax-curve-getClosestPointtoprojection ent
                            (setq p1 (cdr (assoc 10 (entget pt)))) '(0 0 1)))
                         (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))))         ;IF ENDS HERE
 
(setq ssetzv (ssget "X" '((0 . "LINE")(8 . "Z-VALUES"))))
         (command "EXTEND" ten2 "" ssetzv "")
         (command "TRIM" ten1 "" ssetzv "" )
(terpri)
(prompt "\nSelect Z-Value lines: ")
         (setvar "OSMODE" 32)
         (setq ss1 (ssget "X" '((0 . "LINE")(8 . "Z-VALUES"))))
(setvar "OSMODE" 0)
  (progn                                                                        ;PROG1 STARTS HERE
        (setq count 0)
        (repeat (sslength ss1)                                                        ;REPEAT STARTS HERE
        (setq cont (entget (ssname ss1 count)))
        (if (= "LINE" (cdr (assoc 0 cont)))                                        ;IF STARTS HERE
                (progn                                                                ;PROG2 STARTS HERE
                (setq CONST_txt-ht 250.0
                CONST_style "Standard"
                layer (cdr (assoc 8 cont))
                ip (cdr (assoc 10 cont))
                rot (angle (cdr (assoc 10 cont)) (cdr (assoc 11 cont)))
                dist (distance (cdr (assoc 10 cont)) (cdr (assoc 11 cont)))
                ent (list                                                        ;LIST STATS HERE
                (cons 0 "TEXT")
                (cons 100 "AcDbEntity")
                (cons 100 "AcDbText")
                (cons 10 ip)
                (cons 40 CONST_txt-ht)
                (cons 41 1)
                (cons 72 0)
                (cons 1 (rtos dist 2))
                (cons 7 CONST_style)
                (list 210 0.0 0.0 1.0)
                (cons 11 (cdr (assoc 11 cont)))
                (cons 50 rot))
                )
                (entmake ent)
                )                                                                ;PROG2 ENDS HERE
                )                                                                ;IF ENDS HERE
                (setq count (1+ count))
                )                                                                ;REPEAT ENDS HERE
                )                                                                ;PROG1 ENDS HERE
         (setq tSet(ssget "X" '((0 . "TEXT")(8 . "Z-VALUES"))))                                                ;select texts
         (setq mpt1 '(0 0))                                                                ;moving orgin
         (setq mpt2 (polar mpt1 (/ pi 2) 40000))                                                ;momving location
         (command "MOVE" tSet "" mpt1 mpt2 "")                                                ;move command
         (if (setq deli(ssget "X" '((0 . "LINE")(8 . "Z-VALUES"))))                        ;selecting z-vzlues lines
(progn
  (command "ERASE" deli "")))                                                        ;delete lines
 (if(not daly:Direct)(setq daly:Direct "Y"))
 (setq oldDirect daly:Direct)
 (if(not daly:Align)(setq daly:Align "H"))
 (setq oldAlign daly:Align)
 (if(not daly:disMode)(setq daly:disMode "S")) 
 (setq oldDisMode daly:disMode) 
 (if(not daly:strDis)(setq daly:strDis 1000)) 
 (setq oldStrDis daly:strDis)
 (initget "Y X")
 (setq daly:Direct 
   (getkword 
     (strcat "\nSpecify alignment direction [X-axis/Y-axis] <"daly:Direct">: ")))
 (if(null daly:Direct)(setq daly:Direct oldDirect))
 (initget "H L C M R TL TC TR ML MC MR BL BC BR")
 (setq daly:Align 
   (getkword 
     (strcat "\nSpecify justification [Hitest string/Left/Center/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR] <"daly:Align">: "))
alignList '(("L" 0)("C" 1)("R" 2)("M" 4)("TL" 6)("TC" 7)("TR" ("ML" 9)("MC" 10)("MR" 11)("BL" 12)("BC" 13)("BR" 14))
            )                                                        ; end setq 
 (if(null daly:Align)(setq daly:Align oldAlign))
 (initget "S C") 
 (setq daly:disMode 
   (getkword 
     (strcat "\nSpecify distance between strings [standard/Custom] <"daly:disMode">: "))) 
 (if(null daly:disMode)(setq daly:disMode oldDisMode)) 
 (if(= daly:disMode "C") 
   (progn 
   (setq daly:strDis(getdist(strcat "\nSpecify Custom distance <"(rtos daly:strDis)">: "))) 
   (if(null daly:strDis)(setq daly:strDis oldStrDis)) 
   (princ(strcat "\nCustom distance is "(rtos daly:strDis))) 
    )                                                                        ; end progn 
   )                                                                        ; end if
 (while T
 (princ "\n<<< Select DText and press Enter or Esc to Quit >>> ") 
  (if 
    (setq dtSet(ssget '((0 . "TEXT")(8 . "Z-VALUES")))) 
   (progn
     (if(= "Y" daly:Direct)
     (setq dtList(vl-sort(mapcar 
          '(lambda (x)(list x 
        (+(cadr(vlax-safearray->list 
            (vlax-variant-value 
              (vla-get-InsertionPoint x)))) 
                (cadr(vlax-safearray->list 
            (vlax-variant-value 
              (vla-get-TextAlignmentPoint x))))))) 
      (mapcar 'vlax-ename->vla-object 
                 (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex dtSet)))))
          (function(lambda(a b)(>(cadr a)(cadr b))))))
(setq dtList(vl-sort(mapcar 
          '(lambda (x)(list x 
        (+(car(vlax-safearray->list 
            (vlax-variant-value 
              (vla-get-InsertionPoint x)))) 
                (car(vlax-safearray->list 
            (vlax-variant-value 
              (vla-get-TextAlignmentPoint x))))))) 
      (mapcar 'vlax-ename->vla-object 
                 (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex dtSet)))))
          (function(lambda(a b)(<(cadr a)(cadr b))))))
      ); end if
  
    (setq hitStr(caar dtList))
     
     (if(/= "H" daly:Align)
(progn
  (vla-getBoundingBox hitStr 'oldMinPt 'MaxPt)
  (foreach lst alignList
             (if(=(car lst)daly:Align)
               (progn
                 (if 
                         (not 
                          (vl-catch-all-error-p 
                           (vl-catch-all-apply 'vla-put-Alignment(list hitStr(cadr lst)))))
                  (progn
                    (vla-getBoundingBox hitStr 'minPt 'maxPt)
                    (vla-move hitStr minPt oldMinPt)
                    ); end progn
                  ); end if
                 ); end progn
               ); end if
    ); end foreach
  ); end progn
); end if
                 
    (setq tHeight(vla-get-Height hitStr) 
          insPoint(vlax-safearray->list 
                    (vlax-variant-value 
                      (vla-get-InsertionPoint hitStr))) 
          tAlignPt(vlax-safearray->list 
                    (vlax-variant-value 
                      (vla-get-TextAlignmentPoint hitStr))) 
          tAlignment(vla-get-Alignment hitStr) 
          dtList(cdr dtList) 
          disDelta 0.0 
    ); end setq 
   (if(= daly:disMode "S")(setq daly:strDis(* 4 tHeight))) 
     (foreach str dtList 
    (if 
  (not 
      (vl-catch-all-error-p 
           (vl-catch-all-apply 'texAlign (list str)))) 
      (princ) 
      (setq errFlag T) 
      ); end if 
  ); end foreach 
     (if errFlag(princ "\n<!> Some Entities on Locked Layer <!>")) 
 ); end progn 
   (princ "\nStrings isn't selected. ") 
   ); end if
   ); end while
 
         (setvar "clayer" oldlayer)                                                        ;reset variables
(setvar "osmode" oldsnap)
(setvar "cmdecho" oldecho)
(setq *error* temperr)        
 (princ)
 )
[attachment=43920:name]