Close L and C shapes into squares

Close L and C shapes into squares

faugustom
Advocate Advocate
1,023 Views
10 Replies
Message 1 of 11

Close L and C shapes into squares

faugustom
Advocate
Advocate

The is any way or lisp to close all "L" (two perpendicular lines) and "C" (three lines, perpendicular, parallel and aligned) polilynes in a drawing into square closed polilynes? 

0 Likes
Accepted solutions (2)
1,024 Views
10 Replies
Replies (10)
Message 2 of 11

CodeDing
Advisor
Advisor

@faugustom ,

 

Can you post a sample drawing with a few of these L and C shapes please? That would help a lot.

 

Best,

~DD

0 Likes
Message 3 of 11

faugustom
Advocate
Advocate

@CodeDing, thank you for the reply

 

File attached

0 Likes
Message 4 of 11

hak_vz
Advisor
Advisor
Accepted solution

Try this

This will work with polyline entities

 

(defun c:ctr ( / pointlist2d ss p1 p2 p3 i eo coords  adoc *error*)
;hak_vz 29-04-2021
(defun pointlist2d (lst / ret) (while lst (setq	ret (cons (list (car lst) (cadr lst)) ret) lst (cddr lst) ) ) (reverse ret))
(defun *error* ( msg )
	(if (not (member msg '("Function cancelled" "quit / exit abort")))
		(princ (strcat "\nError: " msg))
	)
	(if adoc (vla-endundomark adoc))
	(setvar 'cmdecho 1)
	(princ)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark adoc)
(vla-startundomark adoc)
(setvar 'cmdecho 0)
(princ "\nSelect all line objects with a window selection >")
(setq p1 (getpoint "\nFirst point>"))(setq p2 (getcorner p1 "\nSecond point>"))
(setq ss (ssget "w" p1 p2 '((0 . "LWPOLYLINE")(90 . 4))))
(setq i -1)
(while (< (setq i (1+ i)) (sslength ss))
(setq eo (vlax-ename->vla-object(ssname ss i)))
(vlax-put eo 'Closed 1)
)
(setq ss (ssget "w" p1 p2 '((0 . "LWPOLYLINE")(90 . 3))))
(setq i -1)
(while (< (setq i (1+ i)) (sslength ss))
(setq eo (vlax-ename->vla-object(ssname ss i)))
(setq coords (pointlist2d (vlax-get eo 'Coordinates)))
(setq p1 (car coords) p2 (cadr coords) p3 (last coords))
(setq m (mapcar '* (mapcar '+ p1 p3) '(0.5 0.5)) ang (+ (angle m p2) pi) di (distance m p2))
(setq coords (append (vlax-get eo 'Coordinates)(polar m ang di)))
(vlax-put eo 'Coordinates coords)
(vlax-put eo 'Closed 1)
)
(setvar 'cmdecho 1)
(vla-endundomark adoc)
(princ "\nDone")
(princ)
)

 

After reading your request I thought that elements are lines not polylines so here is a version that works

with lines i.e exploded polylines

 

 

(defun c:ctrlines ( / pointlist2d ss p1 p2 p3 i eo coords  adoc *error*)
;hak_vz 29-04-2021
(defun pointlist2d (lst / ret) (while lst (setq	ret (cons (list (car lst) (cadr lst)) ret) lst (cddr lst) ) ) (reverse ret))
(defun *error* ( msg )
	(if (not (member msg '("Function cancelled" "quit / exit abort")))
		(princ (strcat "\nError: " msg))
	)
	(if adoc (vla-endundomark adoc))
	(setvar 'cmdecho 1)
	(princ)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark adoc)
(vla-startundomark adoc)
(setvar 'cmdecho 0)
(princ "\nSelect all line objects with a window selection >")
(setq ss (ssget "w" (setq p1 (getpoint "\nFirst point>"))(setq p2 (getcorner p1 "\nSecond point>")) '((0 . "LINE"))))
(initcommandversion)
(command "_.pedit" "m" ss "" "y" "j" "" "")
(setq ss (ssget "w" p1 p2 '((0 . "LWPOLYLINE")(90 . 4))))
(setq i -1)
(while (< (setq i (1+ i)) (sslength ss))
(setq eo (vlax-ename->vla-object(ssname ss i)))
(vlax-put eo 'Closed 1)
)
(setq ss (ssget "w" p1 p2 '((0 . "LWPOLYLINE")(90 . 3))))
(setq i -1)
(while (< (setq i (1+ i)) (sslength ss))
(setq eo (vlax-ename->vla-object(ssname ss i)))
(setq coords (pointlist2d (vlax-get eo 'Coordinates)))
(setq p1 (car coords) p2 (cadr coords) p3 (last coords))
(setq m (mapcar '* (mapcar '+ p1 p3) '(0.5 0.5)) ang (+ (angle m p2) pi) di (distance m p2))
(setq coords (append (vlax-get eo 'Coordinates)(polar m ang di)))
(vlax-put eo 'Coordinates coords)
(vlax-put eo 'Closed 1)
)
(setvar 'cmdecho 1)
(vla-endundomark adoc)
(princ "\nDone")
(princ)
)

 

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 5 of 11

Kent1Cooper
Consultant
Consultant

@faugustom wrote:

.... File attached


For the C ones, you can just select them, and in the Properties palette, change the "Closed" item to Yes.  Are you looking to do a wholesale selection of lots of them to process at once?  If so, you obviously don't want to use Properties with the L ones.

Kent Cooper, AIA
0 Likes
Message 6 of 11

CodeDing
Advisor
Advisor
Accepted solution

@faugustom ,

 

Thanks for the drawing. Assuming you will not need to be selecting LINEs, then this will work for you:

(defun c:LCCLOSE ( / ss cnt e eg MultiAssoc ptList)
(setq MultiAssoc (lambda (k l / i) (if (setq i (assoc k l)) (cons (cdr i) (MultiAssoc k (cdr (member i l))))))) (prompt "\nSelect \"L\" & \"C\" shaped Polylines to Close: ") (if (setq ss (ssget '((-4 . "<AND") (0 . "LWPOLYLINE") (-4 . "<OR") (90 . 3) (90 . 4) (-4 . "OR>") (-4 . "&=") (70 . 0) (-4 . "AND>")))) (repeat (setq cnt (sslength ss)) (setq e (ssname ss (setq cnt (1- cnt)))) (setq eg (entget e)) (setq ptList (MultiAssoc 10 eg)) (if (eq 4 (cdr (assoc 90 eg))) (setpropertyvalue e "Closed" 1) ;else (setpropertyvalue (cdr (assoc -1 (entmod (append (subst '(90 . 4) (assoc 90 eg) (reverse (cdr (reverse eg)))) (list (cons 10 (polar (caddr ptList) (angle (cadr ptList) (car ptList)) (distance (cadr ptList) (car ptList)) );polar );cons );list (list (assoc 210 eg)) );apply );entmod );assoc );cdr "Closed" 1 );setpropertyvalue );if );repeat ;else (prompt "\nNo 3 or 4 segment un-closed polylines were found.") );if (setq ss nil) (prompt "\nLCCLOSE Complete.") (princ) );defun

Best,

~DD

Message 7 of 11

faugustom
Advocate
Advocate

CTR works perfectly! Thank you

 

CTRLINES generated an error, but I'm using polylines, so, it's ok!

 

Command: CTRLINES
Select all line objects with a window selection >
First point>
Second point>
Invalid option keyword.
Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Reverse/Undo]:

 

Thank you again

0 Likes
Message 8 of 11

faugustom
Advocate
Advocate

exactly 😉

0 Likes
Message 9 of 11

faugustom
Advocate
Advocate
Perfectly!

Thank you!
0 Likes
Message 10 of 11

Kent1Cooper
Consultant
Consultant

@faugustom wrote:

....

CTRLINES generated an error, but I'm using polylines, so, it's ok!

....

Invalid option keyword.
....


My guess is that you have PEDITACCEPT set to 1, and this line is the problem:

 

(command "_.pedit" "m" ss "" "y" "j" "" "")

 

If the selection involves Lines or Arcs, and PEDITACCEPT is 0, it will ask whether to convert them to Polylines, which is what that "y[es]" answer is for.  If PEDITACCEPT is 1, that question will not be asked, and "y" will be an invalid option.

 

Try either setting PEDITACCEPT to 0 or removing that "y" entry, and see whether it works.

Kent Cooper, AIA
0 Likes
Message 11 of 11

hak_vz
Advisor
Advisor

Thank you @Kent1Cooper.

 

You have pointed out a potential problem with command pedit, that can often be overlooked.

In case PEDITACCEPT  is set to 0 function CRTLINES is actually better since it work both on lines and lwpolylines. In second step,  function collects all lwpolylines inside previously defined window, either preexisting or converted.

If there is no lines to convert (zero selection set), it continues with lwpolilines.

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes