[编程交流] 正在查找PLINE的LISP

(defun C:demo(/ ang1 ang2 points elist endang tick p1 p1r p1u p2 p2r p2u
        p3 p4 pline pmid pt1 pt2 startang)
(setvar 'osmode 0)
(setvar 'cecolor "blue")
(setvar 'plinewid 0)
(command "._pline")
(while (= 1 (logand 1 (getvar 'cmdactive)))
 (command pause))
(setq pline  (entlast)
     points (vl-remove-if
       (function not)
       (mapcar
         (function (lambda (x)
                     (if (= 10 (car x))
                       (cdr x))))
         (setq elist (entget pline))
         )
       )
     tick   25.4 ;<-- ticks length
     )
(setq startang (angle (car points) (cadr points))
     endang   (angle (nth (- (length points) 2) points) (last points))
     )
(setq p1   (polar (car points) (+ startang (/ pi 2)) (/ tick 2))
     pmid (mapcar (function (lambda (a b) (/ (+ a b) 2)))
           (car points)
           p1)
     p2   (polar pmid (+ startang pi) (/ tick )
     p4   (polar (car points) (- startang (/ pi 2)) (/ tick 2))
     pmid (mapcar (function (lambda (a b) (/ (+ a b) 2)))
           (car points)
           p4)
     p3   (polar pmid startang (/ tick )
     )
(setvar 'cecolor "cyan")
(command "_spline" p1 p2 p3 p4 "" p1 p4 "")
(setq p1   (polar (last points) (+ endang (/ pi 2)) (/ tick 2))
     pmid (mapcar (function (lambda (a b) (/ (+ a b) 2)))
           (last points)
           p1)
     p2   (polar pmid (+ endang pi) (/ tick )
     p4   (polar (last points) (- endang (/ pi 2)) (/ tick 2))
     pmid (mapcar (function (lambda (a b) (/ (+ a b) 2)))
           (last points)
           p4)
     p3   (polar pmid endang (/ tick )
     )
(command "_spline" p1 p2 p3 p4 "" p1 p4 "")
(setvar 'cecolor "yellow")
(while (> (length points) 2)
 (setq        ang1 (+ (angle (car points) (cadr points)) pi)
ang2 (angle (cadr points) (caddr points))
pt1  (polar (cadr points) ang1 tick)
p1u  (polar pt1 (+ ang1 (/ pi 2)) (/ tick 2))
p1r  (polar pt1 (- ang1 (/ pi 2)) (/ tick 2))
pt2  (polar (cadr points) ang2 tick)
p2u  (polar pt2 (+ ang2 (/ pi 2)) (/ tick 2))
p2r  (polar pt2 (- ang2 (/ pi 2)) (/ tick 2))
)
 (setvar 'plinewid (/ tick )
 (command "._pline" "_non" p1u "_non" p1r "")
 (command "._pline" "_non" p2u "_non" p2r "")
 (setq points (cdr points))
 )
(princ)
 )