Jump to content

Delete duplicate polyline vertex


w64bit

Recommended Posts

Can anyone please help with a modification for the attached LSP in order to make it to work without user intervention (manual selection or input) on all lwpolylines in current space (model or layout)?

Thank you

DelDupVertex.lsp

Edited by w64bit
Link to comment
Share on other sites

Line 137:

  (setq SELECTION (SSGET "_X" (list (cons 0 "LWPOLYLINE") (cons 410 (getvar "CTAB")))))

instead of 

(setq SELECTION (SSGET  '((0 . "LWPOLYLINE"))))

 

The "_X" selects everything (also layout tabs).  Leaving out the "_X" gives the user the chance to select manually.

(getvar "CTAB") gets you the Current Tab, so add that to the filter

 

And you don't need that while.

Change line 141 to

      (setq DUPDISTANCE A)

then delete or comment out the while loop.

 

  (PRINC "\nSelect lwpolylines to clean ")
  (setq SELECTION (SSGET "_X" (list (cons 0 "LWPOLYLINE") (cons 410 (getvar "CTAB")))))
  (if SELECTION
    (PROGN
      (setq A 1.0e-012)
      (setq DUPDISTANCE A)
;     (while (and (EQUAL (TYPE DUPDISTANCE) 'STR))
;			(INITGET 6 "About Help")
;			(setq DUPDISTANCE
;				   (GETDIST
;				 (STRCAt
;			   "\nTolerance for vertices to be considered duplicate or [About] <"
;				   (RTOS A 1)
;				   ">: "
;				 )
;				   )
;			)
;			(if DUPDISTANCE
;			  (PROGN (if (OR (EQUAL DUPDISTANCE "About")
;					 (EQUAL DUPDISTANCE "Help")
;					 )
;				   (PROGN (ABOUT))
;				 )
;			  )
;			  (PROGN (setq DUPDISTANCE A))
;			)
;		)
      (setq COUNT 0)
      (setq MODIFIED 0)

 

Edited by Emmanuel Delay
Add Current Tab to ssget
  • Like 1
Link to comment
Share on other sites

  • 1 year later...

This lisp routine only removes consecutive duplicates, which is likely what most people need. Unfortunately, because last and first vertices are not technically consecutives, they are not reduced to one vertex, even though they are duplicates and consecutives in the sense of a ring.

I am struggling to modify the lisp so that it covers the last vertex being the same as the first as well, but probably someone versed would figure it in a jiffy.

Link to comment
Share on other sites

I use this (I don't know the author), maybe it will help:
 

;;; remove polyline segments that have 0 length

(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:plz ( / *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

 

  • Like 1
Link to comment
Share on other sites

@enthralled It absolutely helps. Thanks.

PLZ is an odd name for this function, but it does exactly what I need, including what I didn't mention. That is:

It removes all consecutive duplicate vertices, including the last one, if it's the same as the first one.

If the first and last vertices are the same, and if the polyline is not closed, it marks it as closed.

It does not mark the polyline as closed in any other circumstance.

I'm writing this down for anyone who might want to understand the function without testing it (me in the future, hi there)

  • Like 1
Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...