[编程交流] 帮助lisp理顺路线

(defun c:Test (/ s o _p lst lng st)
 ;;        Tharwat 22.7.2015        ;;
 (princ "\nPick on LWpolyline to draw Rectangles between coordinates")
 (if (and (setq s (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
          (setq _p (getpoint "\nSpecify point to redraw the LWpolyline with Rectangles:"))
          )
   (progn
     (setq o   (ssname s 0)
           lst (mapcar 'cdr (vl-remove-if-not '(lambda (p) (eq (car p) 10)) (entget o)))
           st  (car lst)
           )
     (mapcar '(lambda (l)
                (setq lng (cons (distance st l) lng)
                      st  l
                      )
                )
             (cdr lst)
             )
     (entmake
       (append
         (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline") '(90 . 2) '(70 . 0)
               )
         (vl-remove-if-not '(lambda (x) (member (car x) '(62 6 370))) (entget o) )
         (list (cons 10 _p) (cons 10 (polar _p 0. (vlax-curve-getdistatpoint o (vlax-curve-getendpoint o)))))
         )
       )
     (mapcar
       '(lambda (d)
          (entmake (append
                     (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1))
                     (mapcar '(lambda (a p) (cons 10 (polar p a 100.)))
                             (list (* pi 0.5) (* pi 0.5) (* pi 1.5) (* pi 1.5))
                             (list _p (polar _p 0. d) (polar _p 0. d) _p)
                      )
              )
            )
          (setq _p (polar _p 0. d))
          )
       (reverse lng)
       )
     )
   )
 (princ)
 ) (vl-load-com)