[编程交流] 自动创建多段线

(defun c:Test (/ leg _LW ss lt rt k)
 ;;    Tharwat 06. jan. 2014    ;;
 (defun leg (x e) (cdr (assoc x (entget e))))
 (defun _LW (pts)
   (entmakex (append (list '(0 . "LWPOLYLINE")
                           '(100 . "AcDbEntity")
                           '(100 . "AcDbPolyline")
                           (cons 90 (length pts))
                           '(70 . 0)
                     )
                     (mapcar (function (lambda (p) (cons 10 (list (car p) (cadr p))))) pts)
             )
   )
 )
 (princ "\n Select Dimensions ...")
 (if (setq ss (ssget '((0 . "*DIMENSION"))))
   (progn ((lambda (i / sn a b)
             (while (setq sn (ssname ss (setq i (1+ i))))
               (if (< (car (setq a (leg 13 sn))) (car (setq b (leg 14 sn))))
                 (setq rt (cons b rt)
                       lt (cons a lt)
                 )
                 (setq rt (cons a rt)
                       lt (cons b lt)
                 )
               )
             )
           )
            -1
          )
          (if (and (> (length lt) 1) (> (length rt) 1))
            (if (progn (initget 6 "Left Right Both")
                       (setq k (cond ((getkword (strcat "\n Specify a side [Left/Right/Both] < "
                                                        (cond (*side*)
                                                              ((setq *side* "Left"))
                                                        )
                                                        " > :"
                                                )
                                      )
                                     )
                                     (*side*)
                               )
                       )
                )
              (cond ((eq k "Left") (mapcar '_LW (list (vl-sort lt '(lambda (p q) (< (cadr p) (cadr q)))))))
                    ((eq k "Right") (mapcar '_LW (list (vl-sort rt '(lambda (p q) (< (cadr p) (cadr q)))))))
                    (t
                     (mapcar '_LW
                             (list (vl-sort lt '(lambda (p q) (< (cadr p) (cadr q))))
                                   (vl-sort rt '(lambda (p q) (< (cadr p) (cadr q))))
                             )
                     )
                    )
              )
            )
            (princ "\n <!> You should select two dimensions at least <!> ")
          )
   )
 )
 (princ)
)