A Lisp for Closing Polylines & Remove Extra overlapping Vertex

[Anonymous]

Hi There,

I was wondering if someone knows of a time saving tip for my time consuming problem.

I'm working with lots of existing dwg's that contain lots of polylines that are not closed and I know that there's sometimes a problem when hatching polyline entities that are not closed properly plus my OCD of making sure polylines are closed!

My current work around this is to close the polyline from the properties menu and then PEDIT the polyline to move the overlapping vertex and then selecting the polyline to remove the extra vertex. As you can imagine this is very time consuming process, especially with polylines indicating external and internal walls and I've been trying to find a much more efficient way on the web but nothing yet.

I'm not very knowledgeable on LISP yet but I feel that an answer might be using this method.

Thanks in advance for any help with this.

[Anonymous]

I was wondering if someone knows of a time saving tip for my time consuming problem.

I'm working with lots of existing dwg's that contain lots of polylines that are not closed and I know that there's sometimes a problem when hatching polyline entities that are not closed properly plus my OCD of making sure polylines are closed!

My current work around this is to close the polyline from the properties menu and then PEDIT the polyline to move the overlapping vertex and then selecting the polyline to remove the extra vertex. As you can imagine this is very time consuming process, especially with polylines indicating external and internal walls and I've been trying to find a much more efficient way on the web but nothing yet.

I'm not very knowledgeable on LISP yet but I feel that an answer might be using this method.

Thanks in advance for any help with this.

[doaiena]

If i understood your question correctly, i think this will do the job.

(defun c:test ( / ss ctr obj)


(if (setq ss (ssget '((0 . "LWPOLYLINE"))))
(progn

(setq ctr 0)
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (ssname ss ctr)))

;if the pline is NOT closed
(if (not (vlax-curve-isClosed obj))	 
(progn

;if the start and end vertex overlap, remove the last vertex
(if (equal (vlax-curve-getPointAtParam obj (vlax-curve-getEndParam obj))
	   (vlax-curve-getPointAtParam obj (vlax-curve-getStartParam obj)))

(vlax-put obj 'Coordinates (reverse (cdr (cdr (reverse (vlax-get obj 'Coordinates))))))
)

;close the pline
(vla-put-Closed obj :vlax-true)
(vla-Update obj)
))

(setq ctr (1+ ctr))
);repeat

));if ss

(princ)
);defun

[Anonymous]

Thanks for your reply doaiena

I've just tried it on file I happen to have at home, it seems to let me select polylines no problem and action what I require so thanks so much for that but it doesn't let me select 2D Polylines. Is it possible to modify your LISP to select 2D polylines?

Thanks so much!

[dlanorh]

This can be fully automated but :

1. Which point should be assumed correct, the start or the end?

2. What is the maximum distance from start point to end point (closing error) to automatically close?

3. Do these LWPolylines have arc or spline segments and do any of them have an elevation?

4. Are these Polylines on specific layers?

[dlanorh · Accepted solution]

As an example, this works on 2DPolylines and LWPolylines.

You can only select Polylines on unlocked layers at the selection set prompt.

It then iterates through the selectionset, ignoring any closed polylines and displays a keyword prompt using dynamic mode (you can select with the mouse). It gives the closing error and asks if you would like to close the Polyline Yes or No (default is No). If the answer is Yes it removes the end vertex and closes the polyline.

(defun rh:sammlung_n (o_lst grp / tmp n_lst)
  (setq n_lst nil)
  (cond ( (and o_lst (= (rem (length o_lst) grp) 0))
          (while o_lst
            (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst)))
            (setq n_lst (cons (reverse tmp) n_lst) tmp nil)
          );end_while
        )
  );end_cond
  (if n_lst (reverse n_lst))
);end_defun rh:sammlung_n

(defun c:TEST (/ *error* c_doc c_spc sv_lst sv_vals ss cnt ent obj v_lst dst ans)

  (defun *error* ( msg )
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );end_*error*_defun
  
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        sv_lst (list 'osmode 'cmdecho 'dynmode 'dynprompt)
        sv_vals (mapcar 'getvar sv_lst)
  );end_setq
  
  (mapcar 'setvar sv_lst '(0 0 3 1))

  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (prompt "\nSelect Polylines : ")
  (setq ss (ssget ":L" '((0 . "LWPOLYLINE,POLYLINE"))))
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (setq ent (ssname ss (setq cnt (1- cnt))))))
            (cond ( (= :vlax-false (vlax-get-property obj 'closed))
                    (cond ( (= (cdr (assoc 0 (entget ent))) "POLYLINE") (setq v_lst (rh:sammlung_n (vlax-get obj 'coordinates) 3)))
                          ( (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") (setq v_lst (rh:sammlung_n (vlax-get obj 'coordinates) 2)))
                    );end_cond
                    (setq dst (distance (car v_lst) (last v_lst)))
                    (initget "Yes No")
                    (setq ans (cond ( (getkword (strcat "Distance Start Pt -> End Pt " (rtos dst 2 4) " Close Polyline : ? [Yes/No] <No>"))) ("No")))
                    (cond ( (= ans "Yes")
                            (setq v_lst (reverse (cdr (reverse v_lst))))
                            (vlax-put obj 'coordinates (apply 'append v_lst))
                            (vlax-put-property obj 'closed :vlax-true)
                          )
                    );end_cond
                  )
            );end_cond
          );end_repeat
        )
  );end_cond

  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

[Kent1Cooper]

If I understand correctly what you want, and whether "not closed properly" involves the start and end vertices at the same location or with a gap, you may be able to use PLCloseCorner.lsp, >here<.  Take a look through the rest of that thread for a one-pick-at-a-time version of the same at Message 14, and other suggestions.

[Anonymous]

Thank you so much dlanorh

It now works great with polylines and 2D polylines!

[dani-perez]

Hello  dlanorh,

nice code!!, could it be joining the start and the end of plines without removing vertexes or creating new ones?

[dlanorh]

Not sure I completely understand if you mean closing a polyline or joining polylines. Upload an example drawing showing before and after (Acad2010)

[dani-perez]

Hello dlanorh,

Sure, I am attaching an example (student license....home hehe...)

Thanks.

[dlanorh]

You don't need the above code for that. This will allow you to select lwpolylines and polylines NOT on locked layers and will the set the closed property to true, thus closing the polyline.

(defun c:TEST (/ ss cnt obj)
  (setq ss (ssget ":L" '((0 . "LWPOLYLINE,POLYLINE"))))
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))
            (vlax-put-property obj 'closed :vlax-true)
          );end_repeat
        )
  );end_cond
  (princ)
);end_defun

[dani-perez]

 Hello dlanorh

Thanks!!!

[Kent1Cooper]

For that you don't need any code.  Just select one or as many as you want, and in the Properties palette, pick Yes in the "Closed" slot:

[Anonymous]

Will this code work on localized version of Autocad? There are always issues due to translated commands and switches.

[Kent1Cooper]

---

@Anonymous wrote:

Will this code work on localized version of Autocad? There are always issues due to translated commands and switches.

---

Whether you're talking about @dlanorh 's code in Message 5 or Message 11, they don't use any (command) functions, so there can't be any "translated command and switches" [if by switches you mean command options].  In Message 5, you should probably add an underscore to make (ssget)'s no-locked-Layers mode "_:L".  And for its *error* handler to work right, you would need to translate the 

"*BREAK*,*CANCEL*,*EXIT*"

to the equivalents in whatever language [it should work  without doing that, but it would presumably not suppress the error message if you ESCape-cancel], and of course, the various prompts later.