No the routine did not offer global selection, but this one does.
;|
as posted to the autodesk newsgroup by
Brian Hailey, on or around 4/23/03
Function to weed unneeded vertices in a LWpolyline, usually
used for contours.....
|;
(defun c:pvd (/ dist ang sel track polys temp plist pt1 pt2 pt3 cnt
elist)
(command "_.undo" "begin")
(setq dist (getdist "\nmax dist between verts: ")
ang (getreal "\nmax angle between segs: ")
track 0
)
;;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
;; added by CAB 09/07/04 to allow select of ALL plines in drawing
(prompt "\nSelect lwpolys to weed or Enter to select all: ")
(cond ((SETQ sel (SSGET '((0 . "LWPOLYLINE"))))) ; user picked dimensions
((SETQ sel (SSGET "X" '((0 . "LWPOLYLINE"))))) ; all dimensions
) ;_ end of if
;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
(while (< track (sslength sel))
(setq polys (entget (ssname sel track))
temp polys
temp (while (/= (car (nth 0 temp)) 10)
(setq temp (cdr temp))
)
temp (reverse temp)
temp (while (/= (car (nth 0 temp)) 42)
(setq temp (cdr temp))
)
temp (reverse temp)
)
(setq plist nil
plist (append plist
(list (nth 0 temp) (nth 1 temp) (nth 2 temp) (nth 3 temp)))
pt1 (cdr (nth 0 temp))
pt2 (cdr (nth 4 temp))
pt3 (cdr (nth 8 temp))
cnt 0
)
(while (nth (+ cnt 8) temp)
(setq pt1 (cdr (nth cnt temp))
pt2 (cdr (nth (+ cnt 4) temp))
pt3 (cdr (nth (+ cnt 8) temp))
)
(if (and (< (+ (distance pt1 pt2) (distance pt2 pt3)) dist)
(< (abs (- (angle pt1 pt2) (angle pt2 pt3)))(* (/ ang 180.0) pi))
)
(setq temp (append (list (nth 0 temp) (nth 1 temp)
(nth 2 temp) (nth 3 temp)
)
(member (nth 8 temp) temp)
)
)
(setq plist (append plist (list (nth 4 temp) (nth 5 temp)
(nth 6 temp) (nth 7 temp)
)
)
temp (cddddr temp)
)
)
)
(setq plist (append plist (list (nth 4 temp) (nth 5 temp)
(nth 6 temp) (nth 7 temp)
)
)
)
(setq elist (append (list (assoc 0 polys)
(assoc 100 polys)
(assoc 67 polys)
(assoc 410 polys)
(assoc 8 polys)
(cons 100 "AcDbPolyline")
(cons 90 (/ (length plist) 4))
(assoc 70 polys)
)
(if (assoc 43 polys)
(list
(assoc 43 polys)
(assoc 38 polys)
(assoc 39 polys)
)
(list
(assoc 38 polys)
(assoc 39 polys)
)
)
)
)
;;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
;; added by CAB 08/24/04 to include the following info if it exist
(if (assoc 6 polys) ; Line Type
(setq elist (append elist (list (assoc 6 polys))))
)
(if (assoc 48 polys) ; Line Type Scale
(setq elist (append elist (list (assoc 48 polys))))
)
(if (assoc 62 polys) ; Color
(setq elist (append elist (list (assoc 62 polys))))
)
(setq elist (append elist plist (list (assoc 210 polys))))
;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
(entmake elist)
(entdel (ssname sel track))
(setq track (1+ track))
)
(command "_.undo" "end")
(princ)
)
(prompt "\nPolyline Weeder Loaded, Enter PVD to run.")
(princ)