Guest scottpops Posted May 19, 2005 Share Posted May 19, 2005 Hey all, I am a newb at AutoLISP, just started teaching myself... I was trying to create a program to delete vertices in a lwpolyline that are on top of each other however, I cant seem to find much on editing lwpolylines. I have the loop all set up just need to know how to go in and delete the vertex that I dont need. If someone could help me out and let me know how they would go about this that would be great. Thanks! Quote Link to comment Share on other sites More sharing options...
David Bethel Posted May 19, 2005 Share Posted May 19, 2005 I would suggest that you basically have to remake the entity and omiiting the vertice not needed one. Exisiting Entity: ((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 5) (70 . 0) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 0.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 3.5 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 3.5 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 7.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 9.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) ) To Delete a duplicate (entmake (list (0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 0) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 0.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 3.5 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 7.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 9.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) ) ) (entdel existing_ename) Notice that group 90 changes from 5 to 4 -David Quote Link to comment Share on other sites More sharing options...
Guest scottpops Posted May 19, 2005 Share Posted May 19, 2005 Thanks David... OK so that makes sense but how would I go about putting that in a loop to have autoLISP make the new entity on its own? Quote Link to comment Share on other sites More sharing options...
David Bethel Posted May 19, 2005 Share Posted May 19, 2005 Are the points exact duplicates or just the same x,y values? To What precison are they equal? -David Quote Link to comment Share on other sites More sharing options...
Guest scottpops Posted May 20, 2005 Share Posted May 20, 2005 I ask the user for a value for what they want the max range for two points to be apart (such as .001 etc.), store this and then use that to see if there is a duplicate point in the range... (IF (AND (AND ( (> (- (car a) (car z)) negselOption) ) (AND ( (> (- (cadr a) (cadr z)) negselOption) ) ) ) where a is pt#1 and z is pt#2 selOption is the range and negselOption is the negative of the range Quote Link to comment Share on other sites More sharing options...
David Bethel Posted May 20, 2005 Share Posted May 20, 2005 If want to use exact points, the (member) function can do that. For boolean tests with fuzz, points can be compared with (equal) (equal '(1.0 1.0 0.0) '(1.000001 1.0 0) 1e- Should return T because they are equal to with 8 places All points would have to be extrapolated from the entity definition and then each point would have to be compared to the previous point in the list. -David Quote Link to comment Share on other sites More sharing options...
Guest scottpops Posted May 20, 2005 Share Posted May 20, 2005 Here is what I have so far. Maybe you can see where I am going with this program a little bit better. Thanks. (defun c:pointdel () (setq e (entget (car (entsel)))) ;get the entity list (setq len (length e)) ;get the length of the list (setq n 0) ;set counter to zero (setq z (list 0.000 0.000)) (setq selOption (getreal "Enter the spec: ")) (setq negselOption (- 0.000 selOption)) (repeat len ;repeat for the length of the entity list (setq e1 (car (nth n e))) ;get each item in the entity list ;and strip the entity code number (if (= e1 10) ;check for code 10 (vertex) (progn ;if it's group 10 do the following (setq a (cdr (nth n e))) (IF (AND (AND (< (- (car a) (car z)) selOption) (> (- (car a) (car z)) negselOption) ) (AND (< (- (cadr a) (cadr z)) selOption) (> (- (cadr a) (cadr z)) negselOption) ) ) (progn (princ "yes") ;;Enter code to delete vertex here ) ) (terpri) ;new line (setq z (cdr (nth n e))) (princ z) ;print the co-ordinates ) ) (setq n (1+ n)) ;increment the counter ) (princ) ) (princ) OK i am also trying to possibly use the vl-remove-if command but I am not using it properly...if you have any suggestions feel free to help out (defun c:pointdel () (setq e (entget (car (entsel)))) ;get the entity list (setq len (length e)) ;get the length of the list (setq n 0) ;set counter to zero (setq z (list 0.000 0.000)) (setq selOption (getreal "Enter the spec: ")) (setq negselOption (- 0.000 selOption)) (repeat len ;repeat for the length of the entity list (setq e1 (car (nth n e))) ;get each item in the entity list ;and strip the entity code number (if (= e1 10) ;check for code 10 (vertex) (progn ;if it's group 10 do the following (setq a (cdr (nth n e))) (testfunc a z testvar) ;;(vl-remove-if 'testfunc e) (terpri) ;new line (setq z (cdr (nth n e))) (princ z) ;print the co-ordinates ) ;progn ) ;if (setq n (1+ n)) ;increment the counter ) ;repeat (princ) ) ;defun (princ) (defun testfunc (a z testvar) (setq testvar nil) (IF (AND (AND (< (- (car a) (car z)) selOption) (> (- (car a) (car z)) negselOption) ) (AND (< (- (cadr a) (cadr z)) selOption) (> (- (cadr a) (cadr z)) negselOption) ) ) (progn (setq testvar T) ) ) testvar ) Quote Link to comment Share on other sites More sharing options...
David Bethel Posted May 20, 2005 Share Posted May 20, 2005 While I am by no means proficent with the "newer" style entities, I would approch it this way: (defun massoc (key alist / nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)))) (reverse nlist)) ;;;MAIN PROGRAM (defun c:deldpt (/ ss en ed pl fl fuzz nd) ;;;SELECT 1 LWPOLYINE (while (or (not ss) (> (sslength ss) 1)) (princ "\nSelect A LWPOLYLINE To Work With: ") (setq ss (ssget '((0 . "LWPOLYLINE"))))) ;;;GET ENTITY DEFINITION (setq en (ssname ss 0) ed (entget en) pl (massoc 10 ed)) ;;;GET FUZZ FACTOR (initget 7) (setq fuzz (getreal "\nFuzz Tolerance: ")) ;;;SETUP POINT LISTS FOR CAMPARISION (setq fl (list (car pl)) pl (cdr pl)) ;;;COMPARE THE POINT LISTS (while pl (if (not (equal (car fl) (car pl) fuzz)) (setq fl (cons (car pl) fl))) (setq pl (cdr pl))) (setq fl (reverse fl)) ;;;MAKE THE NEW DEFINITION (setq nd (list (cons 0 "LWPOLYLINE") '(100 . "AcDbEntity") (assoc 8 ed) '(100 . "AcDbPolyline") (cons 90 (length fl)) (assoc 70 ed) (assoc 43 ed) (assoc 39 ed) (assoc 38 ed))) (foreach p fl (setq nd (append nd (list (cons 10 p) '(40 . 0)'(41 . 0)'(42 . 0))))) ;;;ADD BACK LINE TYPE LTSCALE & COLOR (setq nd (append nd (list (if (assoc 6 ed) (assoc 6 ed) (cons 6 "BYLAYER"))))) (setq nd (append nd (list (if (assoc 48 ed) (assoc 48 ed) (cons 48 1))))) (setq nd (append nd (list (if (assoc 62 ed) (assoc 62 ed) (cons 62 256))))) (setq nd (append nd (list (assoc 210 ed)))) ;;;MAKE THE NEW LINE (entmake nd) ;;;DELETE THE OLD ONE (entdel en) ;;;CLEANUP THE DRAWING (redraw (entlast)) (prin1)) Hope this helps. -David Quote Link to comment Share on other sites More sharing options...
jawbreaker31 Posted April 24, 2009 Share Posted April 24, 2009 Is there any way to handle the arcs in this code? This will strip out the arc in the polyline. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 24, 2009 Share Posted April 24, 2009 You would have to include the Bulge factor (group 42), but not sure how much this would be affected when vertices are removed. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 24, 2009 Share Posted April 24, 2009 Very quickly modded: (defun massoc (key alist / nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)))) (reverse nlist)) ;;;MAIN PROGRAM (defun c:deldpt (/ ss en ed pl Bl Bl2 i fl fuzz nd) ;;;SELECT 1 LWPOLYINE (while (or (not ss) (> (sslength ss) 1)) (princ "\nSelect A LWPOLYLINE To Work With: ") (setq ss (ssget '((0 . "LWPOLYLINE"))))) ;;;GET ENTITY DEFINITION (setq en (ssname ss 0) ed (entget en) pl (massoc 10 ed) Bl (massoc 42 ed) i 0) ;;;GET FUZZ FACTOR (initget 7) (setq fuzz (getreal "\nFuzz Tolerance: ")) ;;;SETUP POINT LISTS FOR CAMPARISION (setq fl (list (car pl)) pl (cdr pl) Bl2 (list (car Bl)) bl (cdr bl)) ;;;COMPARE THE POINT LISTS (while pl (if (not (equal (car fl) (car pl) fuzz)) (setq fl (cons (car pl) fl) Bl2 (cons (car Bl) Bl2))) (setq pl (cdr pl) Bl (cdr Bl))) (setq fl (reverse fl) Bl2 (reverse Bl2)) ;;;MAKE THE NEW DEFINITION (setq nd (list (cons 0 "LWPOLYLINE") '(100 . "AcDbEntity") (assoc 8 ed) '(100 . "AcDbPolyline") (cons 90 (length fl)) (assoc 70 ed) (assoc 43 ed) (assoc 39 ed) (assoc 38 ed))) (foreach p fl (setq nd (append nd (list (cons 10 p) '(40 . 0)'(41 . 0) (cons 42 (nth i Bl2)))) i (1+ i))) ;;;ADD BACK LINE TYPE LTSCALE & COLOR (setq nd (append nd (list (if (assoc 6 ed) (assoc 6 ed) (cons 6 "BYLAYER"))))) (setq nd (append nd (list (if (assoc 48 ed) (assoc 48 ed) (cons 48 1))))) (setq nd (append nd (list (if (assoc 62 ed) (assoc 62 ed) (cons 62 256))))) (setq nd (append nd (list (assoc 210 ed)))) ;;;MAKE THE NEW LINE (entmake nd) ;;;DELETE THE OLD ONE (entdel en) ;;;CLEANUP THE DRAWING (redraw (entlast)) (prin1)) Quote Link to comment Share on other sites More sharing options...
David Bethel Posted April 24, 2009 Share Posted April 24, 2009 I don't believe that you can have duplicate arc segments in a pline the same way that you can duplicate vertices. I would have to check on it though. -David Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 24, 2009 Share Posted April 24, 2009 Yes, but with the old code, any arc segments within a polyline that had duplicate vertices would be discarded to straight lines... Quote Link to comment Share on other sites More sharing options...
SteveK Posted June 29, 2009 Share Posted June 29, 2009 Edit: Asked in a new thread. Quote Link to comment Share on other sites More sharing options...
ronjonp Posted June 29, 2009 Share Posted June 29, 2009 Is there any way to handle the arcs in this code? This will strip out the arc in the polyline. This will remove duplicate points (no fuzz factor) and preserve arcs in the polylines... (defun c:rdp (/ e rjp-removeduplicates) (defun rjp-removeduplicates (el) (if el (cons (car el) (rjp-removeduplicates (vl-remove (car el) el))) ) ) (and (setq e (car (entsel))) (setq e (entget e)) (= (cdr (assoc 0 e)) "LWPOLYLINE") (entmod (rjp-removeduplicates e)) ) ) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted June 29, 2009 Share Posted June 29, 2009 Nice method Ron - I love the recursive solutions Quote Link to comment Share on other sites More sharing options...
ronjonp Posted June 29, 2009 Share Posted June 29, 2009 Nice method Ron - I love the recursive solutions Thanks Lee ... just found out the solution above will trash polyline widths (not constant) though Quote Link to comment Share on other sites More sharing options...
wiejie Posted February 22, 2010 Share Posted February 22, 2010 Great work for 2D, but this code isn't working for 3D polylines! Is it possible to make a 3D version of this script? Or do I have to start from scratch? Thanks Quote Link to comment Share on other sites More sharing options...
Arizona Posted January 9, 2012 Share Posted January 9, 2012 Thanks guys. That just worked very well for me. Googled "polyline delete duplicate vertices" and of course, look where I wound up. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.