scottpops
6th Jun 2005, 04:33 pm
Hey all, I recently wrote a post asking about deleting polyline verticies that were too close too each other. I have modified that program to now delete any verticies that are on the same line together (meaning 3 pts). I enter the verticies and their respective attributes into their own separate lists and compare 3 at a time to see if there are extra vertices that are not needed in there. The program works fine :D but now I need to make it go through all the layers in the drawing. I know its probably just a simple loop in the beginning but I am drawing a blank. :? Any help would be appreciated. Thanks!
(defun c:vertdel (/ ent1 ent vertlist
widthlistone widthlisttwo
bulgelist newent idx x
firstvert firstwid1 firstwid2 firstbulge
)
(setq ent1 (entnext))
;set ent1 to next entity
(while (/= ent1 nil)
;as long as there is an entity to grab
(if (= "LWPOLYLINE" (cdr (assoc 0 (entget ent1))))
;if the entity is a lwpolyine
(progn
(command "_.undo" "_be")
(setq ent (entget ent1)
;grab entity list
idx 0
;reset index
newent (list (car ent))
;start new list
ent (cdr ent)
; shorten list by 1
vertlist (list (car ent))
;new list with entity name (will be removed later)
widthlistone (list (car ent))
;new list
widthlisttwo (list (car ent))
;new list
bulgelist (list (car ent))
;new list
)
(while ent
;while we still have items in the entity list
(if (not (= 10 (car (setq x (car ent)))))
;check if attribute is a vertice
(setq newent (cons x newent)
;it's not a vertice, add it to the new list
ent (cdr ent)
;shorten the list
)
(progn
;it is a vertice, save for comparison
; add it and the width & bulge values to
;their own lists
(setq vertlist (cons x vertlist))
(setq ent (cdr ent)
x (car ent)
widthlistone (cons x widthlistone)
ent (cdr ent)
x (car ent)
widthlisttwo (cons x widthlisttwo)
ent (cdr ent)
x (car ent)
bulgelist (cons x bulgelist)
)
)
)
)
(setq vertlist (cdr (reverse vertlist))
;reorder lists and get rid of entity name from beginning
widthlistone (cdr (reverse widthlistone))
widthlisttwo (cdr (reverse widthlisttwo))
bulgelist (cdr (reverse bulgelist))
)
(while vertlist
;while there are still objects in vertlist
(if (and
(/= (caddr vertlist) nil)
;as long as there are 3 points to compare
(setq h (* (distance (cdr (car vertlist))
(cdr (cadr vertlist))
;set h to the distance of pt1 and pt2 times
;the sin of the angle between 1 & 2 and 1 & 3
;(getting the height of the second pt
; above the line from pt1 and pt3)
)
(sin (abs
(- (angle (cdr (car vertlist))
(cdr (cadr vertlist))
)
(angle (cdr (car vertlist))
(cdr (caddr vertlist))
)
)
)
)
)
)
(and (< h 0.001)
(> h -0.001)
;-0.001<h<0.001
)
)
;all conditions are met (point 2 is bad)
(setq firstvert (car vertlist)
;set first object in list to separate variable
vertlist (cddr vertlist)
;remove the first two items
vertlist (cons firstvert vertlist)
;add first object back into the beginning of the list
firstwid1 (car widthlistone)
widthlistone (cddr widthlistone)
widthlistone (cons firstwid1 widthlistone)
firstwid2 (car widthlisttwo)
widthlisttwo (cddr widthlisttwo)
widthlisttwo (cons firstwid2 widthlisttwo)
firstbulge (car bulgelist)
bulgelist (cddr bulgelist)
bulgelist (cons firstbulge bulgelist)
)
(progn ;conditions not met (point 1 is good)
(setq newent (cons (car vertlist) newent))
;add first object to newent
(setq newent (cons (car widthlistone) newent))
(setq newent (cons (car widthlisttwo) newent))
(setq newent (cons (car bulgelist) newent))
(setq idx (+ idx 1))
;increment counter, this is so we can set (assoc 90) later
(setq vertlist (cdr vertlist))
;delete point from list
(setq widthlistone (cdr widthlistone))
(setq widthlisttwo (cdr widthlisttwo))
(setq bulgelist (cdr bulgelist))
)
)
)
(setq newent
(subst (cons 90 idx) (assoc 90 newent) (reverse newent))
;update the # of vertices
)
(entmod newent)
;modify the pline
(command "_.undo" "_end")
)
)
(setq ent1 (entnext ent1))
;goto next entity
)
(princ)
) ;end defun
(defun c:vertdel (/ ent1 ent vertlist
widthlistone widthlisttwo
bulgelist newent idx x
firstvert firstwid1 firstwid2 firstbulge
)
(setq ent1 (entnext))
;set ent1 to next entity
(while (/= ent1 nil)
;as long as there is an entity to grab
(if (= "LWPOLYLINE" (cdr (assoc 0 (entget ent1))))
;if the entity is a lwpolyine
(progn
(command "_.undo" "_be")
(setq ent (entget ent1)
;grab entity list
idx 0
;reset index
newent (list (car ent))
;start new list
ent (cdr ent)
; shorten list by 1
vertlist (list (car ent))
;new list with entity name (will be removed later)
widthlistone (list (car ent))
;new list
widthlisttwo (list (car ent))
;new list
bulgelist (list (car ent))
;new list
)
(while ent
;while we still have items in the entity list
(if (not (= 10 (car (setq x (car ent)))))
;check if attribute is a vertice
(setq newent (cons x newent)
;it's not a vertice, add it to the new list
ent (cdr ent)
;shorten the list
)
(progn
;it is a vertice, save for comparison
; add it and the width & bulge values to
;their own lists
(setq vertlist (cons x vertlist))
(setq ent (cdr ent)
x (car ent)
widthlistone (cons x widthlistone)
ent (cdr ent)
x (car ent)
widthlisttwo (cons x widthlisttwo)
ent (cdr ent)
x (car ent)
bulgelist (cons x bulgelist)
)
)
)
)
(setq vertlist (cdr (reverse vertlist))
;reorder lists and get rid of entity name from beginning
widthlistone (cdr (reverse widthlistone))
widthlisttwo (cdr (reverse widthlisttwo))
bulgelist (cdr (reverse bulgelist))
)
(while vertlist
;while there are still objects in vertlist
(if (and
(/= (caddr vertlist) nil)
;as long as there are 3 points to compare
(setq h (* (distance (cdr (car vertlist))
(cdr (cadr vertlist))
;set h to the distance of pt1 and pt2 times
;the sin of the angle between 1 & 2 and 1 & 3
;(getting the height of the second pt
; above the line from pt1 and pt3)
)
(sin (abs
(- (angle (cdr (car vertlist))
(cdr (cadr vertlist))
)
(angle (cdr (car vertlist))
(cdr (caddr vertlist))
)
)
)
)
)
)
(and (< h 0.001)
(> h -0.001)
;-0.001<h<0.001
)
)
;all conditions are met (point 2 is bad)
(setq firstvert (car vertlist)
;set first object in list to separate variable
vertlist (cddr vertlist)
;remove the first two items
vertlist (cons firstvert vertlist)
;add first object back into the beginning of the list
firstwid1 (car widthlistone)
widthlistone (cddr widthlistone)
widthlistone (cons firstwid1 widthlistone)
firstwid2 (car widthlisttwo)
widthlisttwo (cddr widthlisttwo)
widthlisttwo (cons firstwid2 widthlisttwo)
firstbulge (car bulgelist)
bulgelist (cddr bulgelist)
bulgelist (cons firstbulge bulgelist)
)
(progn ;conditions not met (point 1 is good)
(setq newent (cons (car vertlist) newent))
;add first object to newent
(setq newent (cons (car widthlistone) newent))
(setq newent (cons (car widthlisttwo) newent))
(setq newent (cons (car bulgelist) newent))
(setq idx (+ idx 1))
;increment counter, this is so we can set (assoc 90) later
(setq vertlist (cdr vertlist))
;delete point from list
(setq widthlistone (cdr widthlistone))
(setq widthlisttwo (cdr widthlisttwo))
(setq bulgelist (cdr bulgelist))
)
)
)
(setq newent
(subst (cons 90 idx) (assoc 90 newent) (reverse newent))
;update the # of vertices
)
(entmod newent)
;modify the pline
(command "_.undo" "_end")
)
)
(setq ent1 (entnext ent1))
;goto next entity
)
(princ)
) ;end defun