Polyline vertices

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!

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

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?

Are the points exact duplicates or just the same x,y values? To What precison are they equal? -David

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

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

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
)

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

Is there any way to handle the arcs in this code? This will strip out the arc in the polyline.

You would have to include the Bulge factor (group 42), but not sure how much this would be affected when vertices are removed.

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

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

Yes, but with the old code, any arc segments within a polyline that had duplicate vertices would be discarded to straight lines...

Edit: Asked in a new thread.

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

Nice method Ron - I love the recursive solutions

Nice method Ron - I love the recursive solutions

Thanks Lee ... just found out the solution above will trash polyline widths (not constant) though

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

Thanks guys. That just worked very well for me. Googled "polyline delete duplicate vertices" and of course, look where I wound up.