;; Purge-Pline (gile) 2007/11/25
;;
;; Removes all superfluous vertex (overwritten, colinear or concentric)
;; Keeps arcs and widths
;; Keeps aligne vertices which show a width break
;; Closes pline which start point and end point are overwritten
(defun purge
-pline
(pl
/ regular
-width colinear concentric
del
-cadr pour
-car elst closed old
-p old
-b
old-sw old-ew new-d new-p new-b new-sw
new-ew b1 b2
)
;; Evaluates if the pline width is regular on 3 successive points
(defun regular
-width
(p1 p2 p3 ws1 we1 ws2 we2
/ delta
) (/= 0 (setq delta
(- we2 ws1
))) )
)
)
(/ (- we1 (- we2 delta)) delta)
1e-9
)
)
)
)
;; Evaluates if 3 successive vertices are aligned
(defun colinear
(p1 p2 p3 b1 b2
) )
)
)
;; Evaluates if 3 sucessive vertices have the same center
(defun concentric
(p1 p2 p3 b1 b2
/ bd1 bd2
) (/= 0.0 b2)
1e-9
)
)
(tan
(/ (+ (car bd1
) (car bd2
)) 4.0)) )
)
;; Removes the second item of the list
)
;; Pours the first item of a list to another one
)
)
)
)
elst
)
)
)
'(old-p old-sw old-ew old-b new-d)
)
new-d
)
)
)
)
)
)
)
)
)
(T
'(old-p old-sw old-ew old-b)
'(new-p new-sw new-ew new-b)
)
)
)
'(old-p old-sw old-ew old-b)
'(new-p new-sw new-ew new-b)
)
)
)
)
)
)
'(new-sw new-ew new-b)
'(old-sw old-ew old-b)
)
(regular-width
)
)
)
)
)
'(new-p new-sw new-ew new-b)
)
)
)
)
)
)
'(new-p new-sw new-ew)
)
)
)
)
)
)
)
)
)
;; BulgeData Retourne les donnees d'un polyarc (angle rayon centre)
(defun BulgeData
(bu p1 p2
/ ang rad cen
) )
(+ (angle p1 p2
) (- (/ pi
2) ang
)) rad
)
)
(list (* ang
2.0) rad cen
) )
;; TAN Retourne la tangente de l'angle
)
;; SPL Calling function
"\nSelect les polylines to be treated or <All>: "
)
)
ss
(purge-pline pl)
)
)
(princ "\nNone selected polyline.") )
)
"\nSimp-Pline loaded, type SPL to launch the function."
)