[编程交流] Lisp程序分到一定长度

;;  StoneSegments for Stone by www.CADTutor.com with help from Eric Monceaux
;;  pick 2 points & it draws mortar joints
;;  suitable for vertical sides only
;;  For North American Stone Company
(defun c:ss (/ dxf tmp del ent elst #len startpt endpt ang #seglen pt p1 p2 clayer a90 slst
            )
 ;;  Set current or Create
 (defun layersetcurrent (layername layercolor)
   ;;  expects var LayerColor
   (or layercolor (setq layercolor 7))
   (if (tblsearch "Layer" layername)
     (command "._layer" "_thaw" layername "_on" layername "_unlock" layername "_set" layername ""
             ) ;_ closes command
     (command "._layer" "_make" layername "_color" layercolor layername ""
             ) ;_ closes command
   )
 )
 (defun dxf (code lst)
   (cdr (assoc code lst))
 )
 ;;Make 2D point from 3D point
 (defun 3dp->2dp (3dpt) (list (car 3dpt) (cadr 3dpt)))
 (or #seg (setq #seg 4))
 (setq #gap 0.25)
 (or #mlen (setq #mlen 6))
[color=Red];;;  (initget 6) ; No null, negative, zero
;;;  (setq tmp (getint (strcat "\nEnter the number of segments.<" (itoa #seg) ">")))
;;;  (setq #seg (if tmp tmp #seg))[/color]
 (initget 6) ; No null, negative, zero
 (setq tmp (getdist (strcat "\nEnter width of surround.<" (rtos #mlen) ">")))
 (setq #mlen (if tmp tmp #mlen))
 (setq p1 (getpoint "\nPick bottom of longest side."))
 (setq p2 (getpoint p1 "\nPick top of longest side."))
 (if (and p1 p2)
   (progn
[color=Blue]     (if (> (setq #len (distance p1 p2)) 36.) ; 36" ~ 0.9144
   (if (= (fix (setq #seg (/ #len 36.))) #seg)
     (setq #seg (fix #seg))
     (setq #seg (fix (1+ #seg)))
     )
   )[/color]
     (setq #seglen (/ (- #len (- (* #seg #gap) #gap)) #seg))
     (if (minusp #seglen)
       (alert "Line is too short.")
       (progn
         (setq clayer (getvar "clayer")
               ang    (angle p1 p2)
               pt     (polar p1 ang #seglen)
               a90    (+ ang (/ pi 2))
         )
         (layersetcurrent "Mortar" 2)
         (setq slst (ssadd))
         (repeat (- #seg 1)
           (command "._Line" "_non" pt "_non" (polar pt a90 #mlen) "")
           (setq slst (ssadd (entlast) slst))
           (command "._Line" "_non" (setq pt (polar pt ang #gap)) "_non" (polar pt a90 #mlen) "" )
           (setq slst (ssadd (entlast) slst))
           (setq pt (polar pt ang #seglen))
         )
         (setvar "clayer" clayer)
         (initget "Yes No")
         (setq ans (getkword "Flip Lines? <No> "))
         (if (= ans "Yes")
           (command ".mirror" slst "" "non" p1 "non" p2 "Y")
         )
       )
     )
   )
 )
 (princ)
)
(prompt "\nStone Segments Loaded, enter ss to run. For North American Stone Company")
(princ)