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

(defun C:pipe (/ *error* ang1 ang2 cec elist endang osm p1 p1r p1u p2 p2r p2u p3 p4
           pline pmid points pt1 pt2 pwid startang tick)
 
(defun *error*    (msg)
 (if
   (vl-position
     msg
     '("console break"
   "Function cancelled"
   "quit / exit abort"
   )
     )
    (princ "   >> Error occurs!")
    (princ msg)
    )
 (command "._undo" "_E")
 (if osm (setvar "osmode" osm))
 (if cec (setvar "cecolor" cec))
 (if pwid (setvar "plinewid" pwid))
 (setvar "cmdecho" 1)  
 )
(command "._undo" "_BE")  
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq cec (getvar "cecolor"))
(setvar "cecolor" "cyan")
(setq pwid (getvar "plinewid"))
(setvar "plinewid" 0)
(setvar "cmdecho" 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   2.5 ;<-- ticks length
     )
(command "._zoom" "_O" pline "")
(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" "blue")
(command "_spline" "_non" p1 "_non" p2 "_non" p3 "_non" 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" "_non" p1 "_non" p2 "_non" p3 "_non" 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))
 )
 (*error* "")
(princ)
 )
(princ "\n\t\t***\tType PIPE to execute\t***")
(princ)