Lisp Routine to lower size

[nkennelly]

I have a set of contours imported from Terramodel for an extension of pavement we are doing (the contours is for some grading we are having to do). I am looking for a routine that will lower the amount of points cause all these polylines have TONS of them... and when I take them to import them into 3DS MAX, it makes for a huge terrain object.

Any help is appreciated.
Nick

[rkmcswain]

Are you using vanilla AutoCAD?
Are you wanting to write your own routine?
Are you looking for a freebie, or something with a price?

[CAB2k]

;|
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)

[oompa_l]

i was excited to find this but my polyline is producing an error when I feed it to the lsp routine:

"Select objects: ; error: bad argument type: 2D/3D point: 0"

any ideas why? anyone have an alternative strategy for removing vertices from a polyline without going through them one by one?

[CAB2k]

I did not write the routine but if you will post a sample DWG with the offending LWpolyline I'll take a look.