remove polyline segments that have 0 length

[barry2104]

I often have closed 2D polylines that for some reason have the start and end point nodes on the same coordinate. A simple 6 sided closed polyline then shows through the properties not just 6 but 7 nodes, see pics below (running CAD in Germany as you can see)

Is there a lisp out there that removes these unnecessary nodes with identical coordinates to other (adjacent) nodes, resulting in a segment length of 0?

I have tried _OVERKILL but this doesn't work for me in this specific situation. The lisp PLDIET also doesn't do the trick for me. To get around this, I've had to explode the polyline, remove the point/line with L=0 (not always), then select my lines and rejoin them to get the desired closed object... tedious

[Ajilal.Vijayan]

First change your polyline, Closed -> Yes

Then try the lisp from here

[Kent1Cooper]

There are several routines out there to do this kind of thing.  >Here< is mine - PLCloseCorner.lsp.  It is only for where the first and last vertices are at [or very close to] the same place, not for coincident vertices / zero-length segments in other places, which are also possible.  It's for selecting one, but Message 26 there has a variant that will do all [or with slight modification multiple User-selected] such Polylines.

[barry2104]

works great, unfortunately only for a single / selected polyline and not multiple.

Don't suppose you/anyone knows of a tweak to the lisp to let you run it on "all selected polylines" or even on simply "all polylines found within the drawing"?

[Kent1Cooper]

---

@barry2104 wrote:

.... Don't suppose you/anyone knows of a tweak to the lisp to let you run it on "all selected polylines" or even on simply "all polylines found within the drawing"?

---

Did you try the one at Message 26 in the link in my previous Message?  Directly, >here<.

[barry2104]

I did give that a try but couldn't get it to work at all

Befehl:  PLSCL
Keine sichtbaren Kontrollpunkte
Ungültiger Optionstitel.
Funktion abgebrochen
Option eingeben [Schließen/Verbinden/Breite/BEarbeiten/kurve Angleichen/Kurvenlinie/kurve beGradigen/LInientyp/Richtung wechseln/Zurück]: *Abbruch*

translates roughly to:

Command: PLSCL
no visible control points
invalid option title
command ended
Options (close, join, width, adjust, adjust curve, curve line, curve straighten, linetype, change direction, back): *cancel*

[Ajilal.Vijayan]

try the updated code

;;; Clean_poly Supprime tous les sommets superposés des polylignes, optimisées, 2D et 3D

;;; TRUNC Retourne la liste tronquée à partir de la première occurrence
;;; de l'expression (liste complémentaire de celle retournée par MEMBER)

;;; Code Originaly by Gile [2006-12-10]
;;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/delete-double-vertices/td-p/1790082

;;; Edited the code to allow multiple polyline selection
;;; AV [2020-03-23]



(defun trunc (expr lst) 
  (cond 
    ((or (null lst) 
         (equal (car lst) expr)
     )
     nil
    )
    (T (cons (car lst) (trunc expr (cdr lst))))
  )
)


(defun removeDuplicateVertices (e_lst / p_lst vtx1 vtx2)
  (cond 
    ((= "LWPOLYLINE" (cdr (assoc 0 e_lst)))
     (setq p_lst (vl-remove-if-not 
                   '(lambda (x) 
                      (or (= (car x) 10) 
                          (= (car x) 40)
                          (= (car x) 41)
                          (= (car x) 42)
                      )
                    )
                   e_lst
                 )
           e_lst (vl-remove-if 
                   '(lambda (x) 
                      (member x p_lst)
                    )
                   e_lst
                 )
     )
     (if (= 1 (cdr (assoc 70 e_lst))) 
       (while (equal (car p_lst) (assoc 10 (reverse p_lst))) 
         (setq p_lst (reverse 
                       (cdr 
                         (member (assoc 10 (reverse p_lst)) 
                                 (reverse p_lst)
                         )
                       )
                     )
         )
       )
     )
     (while p_lst 
       (setq e_lst (append e_lst (trunc (assoc 10 (cdr p_lst)) p_lst))
             p_lst (member (assoc 10 (cdr p_lst)) (cdr p_lst))
       )
     )
     (entmod e_lst)
    )
    ((and (= "POLYLINE" (cdr (assoc 0 e_lst))) 
          (zerop (logand 240 (cdr (assoc 70 e_lst))))
     )
     (setq e_lst (cons e_lst nil)
           vtx1  (entnext ent)
           vtx2  (entnext vtx1)
     )
     (while (= (cdr (assoc 0 (entget vtx1))) "VERTEX") 
       (if (= (cdr (assoc 0 (entget vtx2))) "SEQEND") 
         (if 
           (or 
             (not 
               (equal (assoc 10 (entget vtx1)) 
                      (assoc 10 (last (reverse (cdr (reverse e_lst)))))
               )
             )
             (zerop (logand 1 (cdr (assoc 70 (last e_lst)))))
           )
           (setq e_lst (cons (entget vtx1) e_lst))
         )
         (if 
           (not 
             (equal (assoc 10 (entget vtx1)) (assoc 10 (entget vtx2)) 1e-9)
           )
           (setq e_lst (cons (entget vtx1) e_lst))
         )
       )
       (setq vtx1 vtx2
             vtx2 (entnext vtx1)
       )
     )
     (setq e_lst (reverse (cons (entget vtx1) e_lst)))
     (entdel ent)
     (mapcar 'entmake e_lst)
    )
    (T (princ "\nEntité non valide."))
  )
)

;;; Fonction principale

(defun c:clean_poly (/ e s i e_lst) 
  
  (if (setq s (ssget '((0 . "*POLYLINE"))))
			(progn
				(setq i (1- (sslength s)))
				(while (<= 0 i)
					(setq 
              e (ssname s i)
              e_lst (entget e)
						  i (1- i)
					)
      (removeDuplicateVertices e_lst)
				)
			)
		);if  
  (princ)
) 

[dlanorh · Accepted solution]

You could try this

(defun rh:del_dup_pts (lst fuzz / n_lst)
  (while (> (length lst) 1) (if (> (distance (car lst) (cadr lst)) fuzz) (setq n_lst (cons (car lst) n_lst))) (setq lst (cdr lst)))
  (setq n_lst (cons (car lst) n_lst))
  (reverse n_lst)
);end_defun

(vl-load-com)

(defun c:spv ( / *error* ss fuzz cnt ent elst obj vlst)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (setq ss (ssget '((0 . "LWPOLYLINE"))) fuzz 1.0e-4)
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq ent (ssname ss (setq cnt (1- cnt)))
                  elst (entget ent)
                  obj (vlax-ename->vla-object ent)
                  vlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) elst))
            );end_setq

            (cond ( (and (= :vlax-true (vlax-get-property obj 'closed)) (equal (car vlst) (last vlst) fuzz))
                    (setq vlst (rh:del_dup_pts (reverse (cdr (reverse vlst))) fuzz))
                  )
                  ( (and (= :vlax-false (vlax-get-property obj 'closed)) (equal (car vlst) (last vlst) fuzz))
                    (setq vlst (rh:del_dup_pts (reverse (cdr (reverse vlst))) fuzz))
                    (vlax-put-property obj 'closed :vlax-true)
                  )
                  (t
                    (setq vlst (rh:del_dup_pts vlst fuzz))
                  )
            );end_cond
            (vlax-put obj 'coordinates (apply 'append vlst))
          );end_repeat
        )
  );end_cond
  (princ)
);end_defun

[barry2104]

works great.

The only "nice to have" extra would be to show how many useless nodes were removed, e.g. after running the lisp on a selection of polylines, the command bar then shows e.g. "14 Nodes were removed"

[dlanorh]

---

@barry2104 wrote:

works great.

The only "nice to have" extra would be to show how many useless nodes were removed, e.g. after running the lisp on a selection of polylines, the command bar then shows e.g. "14 Nodes were removed"

---

This should address that

(defun rh:del_dup_pts (lst fuzz / n_lst)
  (while (> (length lst) 1) (if (> (distance (car lst) (cadr lst)) fuzz) (setq n_lst (cons (car lst) n_lst))) (setq lst (cdr lst)))
  (setq n_lst (cons (car lst) n_lst))
  (reverse n_lst)
);end_defun

(vl-load-com)

(defun c:spv ( / *error* ss fuzz vtot cnt ent elst obj vlst vno nvno)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (setq ss (ssget '((0 . "LWPOLYLINE"))) fuzz 1.0e-4 vtot 0)
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq ent (ssname ss (setq cnt (1- cnt)))
                  elst (entget ent)
                  obj (vlax-ename->vla-object ent)
                  vlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) elst))
                  vno (length vlst)
            );end_setq

            (cond ( (and (= :vlax-true (vlax-get-property obj 'closed)) (equal (car vlst) (last vlst) fuzz))
                    (setq vlst (rh:del_dup_pts (reverse (cdr (reverse vlst))) fuzz))
                  )
                  ( (and (= :vlax-false (vlax-get-property obj 'closed)) (equal (car vlst) (last vlst) fuzz))
                    (setq vlst (rh:del_dup_pts (reverse (cdr (reverse vlst))) fuzz))
                    (vlax-put-property obj 'closed :vlax-true)
                  )
                  (t
                    (setq vlst (rh:del_dup_pts vlst fuzz))
                  )
            );end_cond
            (setq nvno (length vlst))
            (vlax-put obj 'coordinates (apply 'append vlst))
            (setq vtot (+ vtot (- vno nvno)))
          );end_repeat
          (princ (strcat "\n" (itoa vtot) " Nodes removed from " (itoa (sslength ss)) (if (> (sslength ss) 1) " Polylines" " Polyline")))
        )
  );end_cond
  (princ)
);end_defun

[hamza_itani]

(defun rh:del_dup_pts (lst fuzz / n_lst)
  (while (> (length lst) 1) (if (> (distance (car lst) (cadr lst)) fuzz) (setq n_lst (cons (car lst) n_lst))) (setq lst (cdr lst)))
  (setq n_lst (cons (car lst) n_lst))
  (reverse n_lst)
);end_defun

(vl-load-com)

(defun c:spv ( / *error* ss fuzz vtot cnt ent elst obj vlst vno nvno)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (setq ss (ssget '((0 . "LWPOLYLINE"))) fuzz 1.0e-4 vtot 0)
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq ent (ssname ss (setq cnt (1- cnt)))
                  elst (entget ent)
                  obj (vlax-ename->vla-object ent)
                  vlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) elst))
                  vno (length vlst)
            );end_setq

            (cond ( (and (= :vlax-true (vlax-get-property obj 'closed)) (equal (car vlst) (last vlst) fuzz))
                    (setq vlst (rh:del_dup_pts (reverse (cdr (reverse vlst))) fuzz))
                  )
                  ( (and (= :vlax-false (vlax-get-property obj 'closed)) (equal (car vlst) (last vlst) fuzz))
                    (setq vlst (rh:del_dup_pts (reverse (cdr (reverse vlst))) fuzz))
                    (vlax-put-property obj 'closed :vlax-true)
                  )
                  (t
                    (setq vlst (rh:del_dup_pts vlst fuzz))
                  )
            );end_cond
            (setq nvno (length vlst))
            (vlax-put obj 'coordinates (apply 'append vlst))
            (setq vtot (+ vtot (- vno nvno)))
          );end_repeat
          (princ (strcat "\n" (itoa vtot) " Nodes removed from " (itoa (sslength ss)) (if (> (sslength ss) 1) " Polylines" " Polyline")))
        )
  );end_cond
  (princ)
);end_defun

Hi, using this on polylines with arcs, is changing the total length of the polyline and causing deformations, can this be fixed?

(Attached DWG + Screenshot)

---

[hamza_itani]

Never mind, I found a way.

Thanks.