[编程交流] Lisp自动调整成吨的线条

(defun c:Test (/ _pts ss ch i sn en p1 p2 sf n l 2p)
 ;;----------------------------------------------------;;
 ;;         Author: Tharwat Al Shoufi        ;;
 ;;        Date: 08. May. 2015            ;;
 ;;----------------------------------------------------;;
 (if (setq ss (ssget '((0 . "LINE"))))
   (progn
     (setq ch (getvar 'cmdecho))
     (setvar 'cmdecho 0)
     (defun _pts (lst)
   (if lst
     (cons (list (car lst) (cadr lst) (caddr lst))
           (_pts (cddddr lst))
     )
   )
 )
     (repeat (setq i (sslength ss))
       (setq sn (ssname ss (setq i (1- i)))
             en (entget sn)
             p1 (cdr (assoc 10 en))
             p2 (cdr (assoc 11 en))
             sf (ssget "_F" (list p1 p2) '((0 . "*POLYLINE")))
       )
       (repeat (setq n (sslength sf))
         (if
           (setq
             l (vlax-invoke
                 (vlax-ename->vla-object (ssname sf (setq n (1- n))))
                 'Intersectwith
                 (vlax-ename->vla-object sn)
                 AcExtendnone
               )
           )
            (progn
              (foreach p (_pts l)
                (if (not (equal (distance p p1) 0. 1e-)
                  (if (< (distance p p1) (distance p p2))
                    (setq 2p (list p p1))
                    (setq 2p (list p p2))
                  )
                )
              )
              (mapcar
                '(lambda (j k)
                   (command "_.dimlinear" "_non" j "_non" k "_non" j)
                 )
                (list p1 (car 2p))
                (list p2 (cadr 2p))
              )
            )
         )
       )
     )
     (setvar 'cmdecho ch)
   )
 )
 (princ)
)(vl-load-com)