[编程交流] 2010 lisp故障

(defun c:APLAC (/ oldcmd ss r1 c1 rc pt1 pt2 pt3 basepoint xbase ybase rad deg inspt inspt2)
 (setq oldcmd (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (princ "-----Space evenly-----")
 (setq aa (getstring "\n Perpendicular space / Twisted Space <T> "))
 (setq r1 (getint "\n Number of rows: "))
 (setq c1 (getint "\n Number of columns: "))
 (setq rc (+ c1 r1))
 (if (= aa "") ; Perpendicular space
   (progn
     (setq pt1 (getpoint "\n Upper left corner: "))
     (setq pt3 (getcorner pt1 "\n Lower right corner"))
     (setq pt2 (list (car pt1) (cadr pt3) 0))
   )
   (progn ; Twisted space
     (setq pt1 (getpoint "\n Upper left corner: "))
     (princ "\n Lower left corner: ")
     (command "_.line" pt1 pause "")
     (setq pt2 (getvar "lastpoint"))
     (command "_.erase" pt1 "")
     (princ "\n Lower right corner: ")
     (command "_.line" pt2 pause "")
     (setq pt3 (getvar "lastpoint"))
     (command "_.erase" pt2 "")
   )
  )
 (setq xbase (/ (distance pt3 pt2) (* c1 2))) ; X-coord for array
 (setq ybase (/ (distance pt1 pt2) (* r1 2))) ; Y-coord for array
 (setq rad (angle pt2 pt3)) ; Angle for twisted space
 (setq deg (* 180.0 (/ rad pi))) ; Angle in degree for twisted space
 (setq basepoint(list (+ (car pt2) xbase) (+ (cadr pt2) ybase) 0)) ; Coordinate for array
  (while (= ss nil) ; Chose symbol
    (setq ss(entsel))
  )
 (setq inspt(cdr(assoc 10 (entget (car ss))))) ; Insertion point for chosen symbol
 (command "_copy" ss "" inspt basepoint)
 (command "_rotate" (ssget "L") "" pt2 deg)
 (setq inspt2(cdr(assoc 10 (entget (ssname (ssget "L") 0))))) ; Insertion point for symbol in array
 (command "rotate" (ssget "L") "" inspt2 pause) ; Rotates symbol before array
 (if (> rc 2) ; Array only if the sum of rows and colums is larger than2
   (progn
   (command "ucs" "3" pt2 pt3 pt1)
   (cond ((= r1 1) ; Array at row=1
     (progn
      (command "_.array" (ssget "L") "" "R" r1 c1 (/ (distance pt3 pt2) c1) )
     )
     )
     ((= c1 1) ; Array at column=1
     (progn
      (command "_.array" (ssget "L") "" "R" r1 c1 (/ (distance pt1 pt2) r1))
     )
     )
     ( ; Array for any combination of rows and columns
     (progn
      (command "_.array" (ssget "L") "" "R" r1 c1 (/ (distance pt1 pt2) r1) (/ (distance pt3 pt2) c1) )
     ) 
     )
   ) ;end cond
   (command "_.ucs" "w")
   ) ;end progn
 ) ;end if
 (setvar "cmdecho" oldcmd)
 (princ)
) ; end defun