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

(defun c:pleasemoredetail()
(command "pline"
        (foreach d (acet-ss-to-list (ssget '((0 . "DIMENSION"))))
                (command "_non" (acet-dxf 13 (entget d)))
        )
)
)

(defun c:Test (/ leg ss l)
 ;;    Tharwat 06. jan. 2014    ;;
 (defun leg (x e) (cdr (assoc x (entget e))))
 (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 l (cons b l))
                 (setq l (cons a l))
               )
             )
           )
            -1
          )
          (if (and l (> (length l) 1) (setq l (vl-sort l '(lambda (p q) (< (cadr p) (cadr q))))))
            (entmakex (append (list '(0 . "LWPOLYLINE")
                                    '(100 . "AcDbEntity")
                                    '(100 . "AcDbPolyline")
                                    (cons 90 (length l))
                                    '(70 . 0)
                              )
                              (mapcar (function (lambda (p) (cons 10 (list (car p) (cadr p))))) l)
                      )
            )
          )
   )
 )
 (princ)
)