Locate Endpoints that do not connect, then indicate those points

[ricodominguez]

does anyone have a lisp file that will locate end points that do not connect and then identifies them with some type of marker?

i once had a lisp that drew a red circle around points that did not connect but i lost it over the years.


i'm trying to extrude complex shapes and if there is one broken line i have to zoom in until i find it. this is a hassle looking at each end point to make sure it's closed.

[jimmy.dhondt]

Hi Rico,

I thought this was a nice challenge and here is my solution.
Didn't do much checking on errors and so on...made this one in a hurry.
Works on Acad2002


(defun c:IsClosed (/ OldColor ss1 ListLength Counter ss L1 L2)
(setq OldColor (getvar "CECOLOR"))
(setvar "CECOLOR" "1")
(setq ss1 (ssget '((0 . "LWPOLYLINE"))))
(setq ListLength (sslength ss1))
(setq Counter 0)
(while (< Counter Listlength)
(setq ss (entget (ssname ss1 Counter)))
(if (/= (cdr (assoc 70 ss)) 1)
(progn
(setq L1 (cdr (assoc 10 ss)))
(setq L2 (cdr (assoc 10 (reverse ss))))
(if (or (/= (car L1) (car L2)) (/= (cadr L1) (cadr L2)))
(progn
(command "circle" L1 (* 10 (getvar "dimscale")))
(command "circle" L2 (* 10 (getvar "dimscale")))
) ;end progn
) ;end if
) ;end progn
) ;end if
(setq Counter (+ Counter 1))
) ;end while
(setvar "CECOLOR" OldColor)
(princ)
)

Jimmy

[ricodominguez]

jimmy

your lisp gave me the following error

ISCLOSED
Select objects: Specify opposite corner: 2 found
2 were filtered out.

Select objects:
; error: bad argument type: lselsetp nil


it seemed like it was able to recognize the broken end points and even changed my layer color to red..your on the right track thaks for your help

[kennet.sjoberg]

The "ISCLOSED" do mark both endpoints on all selected open "LWPOLYLINE" only.

: ) Happy Computing !

kennet

[jimmy.dhondt]

I assumed that all polylines are LWpolylines nowadays?
Are polylines still being used?

Jimmy

[mjfarrell]

Jimmy,

It's a mixed bag your drawing could have a mixture
of both types of poly lines.

[dbrower]

Try Changing the (0 . "LWpolyline") to (0 . "*polyline")

[peter]

I use regular weight polylines regularly.

My code usually handle either lwpolylines or polylines.

Peter Jamtgaard

[kennet.sjoberg]

Hi Rico, here is a program specially made 4U, it works on almost every ordinary object with endpoints.
The program create circles on layer "CIRCLES" on all selected objects endpoints, then erase all equal created circles,
left is circles on free endpoints. . . NotConnected objects. . .

(defun c:NotConnected (/ OldErr SelSet OldLay Counter EntName EntDxf End1 End2
CirList SelSetCir CirDxf Index Cir1 CirName1 CirOrigin1 fuzz Hit )

;;;__Errorhandler__
(defun NotConnected_err ( msg / )
(if (= (getvar "ERRNO" ) 52 ) (princ "Function cancelled by User [Esc] !" ) ( ) )
(command "_.UNDO" "End" )
(command "_.U" )
(setq *error* OldErr )
(princ)
)

;;; *** MAIN ***
(command "_.UNDO" "BEgin" )
(setq OldErr *error* *error* NotConnected_err )

;;; Create circles on all endpoints
(prompt "Command : Select objects to examine : " )
(if (setq SelSet (ssget ) )
(progn
(setq OldLay (getvar "CLAYER" ) )
(if (= (tblsearch "LAYER" "CIRCLES") nil )
(command "layer" "n" "CIRCLES" "c" "1" "CIRCLES" "lt" "continuous" "CIRCLES" "" )
( )
)
(setvar "CLAYER" "CIRCLES" )
(setq Counter 0 )
(setq EntName (ssname SelSet Counter ) )
(while EntName
(setq EntDxf (entget EntName ) )
(cond
((= (cdr (assoc 0 EntDxf )) "LINE" ) (setq End1 (cdr (assoc 10 EntDxf )) End2 (cdr (assoc 11 EntDxf ))) )
((= (cdr (assoc 0 EntDxf )) "LWPOLYLINE" ) (setq End1 (cdr (assoc 10 EntDxf )) End2 (cdr (assoc 10 (reverse EntDxf )))) )
((= (cdr (assoc 0 EntDxf )) "ARC" ) (setq End1 (polar (cdr (assoc 10 EntDxf )) (cdr (assoc 50 EntDxf )) (cdr (assoc 40 EntDxf )))
End2 (polar (cdr (assoc 10 EntDxf )) (cdr (assoc 51 EntDxf )) (cdr (assoc 40 EntDxf )))) )
((= (cdr (assoc 0 EntDxf )) "SPLINE" ) (setq End1 (cdr (assoc 10 EntDxf )) End2 (cdr (assoc 11 (reverse EntDxf )))) )
((= (cdr (assoc 0 EntDxf )) "POLYLINE" ) (progn (setq EntName (cdr (assoc -1 EntDxf )) )
(setq EntDxf (entget (setq EntName (entnext EntName ))) )
(while (= (cdr (assoc 0 EntDxf )) "VERTEX" )
(if (not End1 ) (setq End1 (cdr (assoc 10 EntDxf ))) (setq End2 (cdr (assoc 10 EntDxf ))) )
(setq EntDxf (entget (setq EntName (entnext EntName )))))) )
(t nil)
)
(if (= (cdr (assoc 70 EntDxf )) 1 ) (setq End1 nil End2 nil ) ( ) ) ; ignore closed poly
(if End1 (command "._circle" End1 (* 10 (getvar "DIMSCALE" )) ) ( ) )
(if End2 (command "._circle" End2 (* 10 (getvar "DIMSCALE" )) ) ( ) )
(setq End1 nil End2 nil )
(setq Counter (1+ Counter ) )
(setq EntName (ssname SelSet Counter ) )
)

;;; Erase all circles with same coordinates
(setq CirList (list nil ) )
(setq SelSetCir (ssget "_X" '((0 . "CIRCLE" )(8 . "CIRCLES" ))) )
(setq Counter 0 )
(repeat (sslength SelSetCir )
(setq CirDxf (entget (ssname SelSetCir Counter )) )
(setq CirList (append CirList (list (list (cdr (assoc -1 CirDxf )) (cdr (assoc 10 CirDxf ))))) )
(setq Counter (1+ Counter ) )
)
(setq CirList (vl-remove nil CirList ))

(setq Index 0 )
(while (> (length CirList ) Index )
(setq Cir1 (nth Index CirList ) )
(setq CirName1 (car (nth Index CirList )) )
(setq CirOrigin1 (cadr (nth Index CirList )) )
(setq CirList (vl-remove Cir1 CirList ) )
(setq Counter 0 )
(while (> (length CirList ) Counter )
(setq fuzz 6 )
(if ;; (equal CirOrigin1 (cadr (nth Counter CirList )) ) <-- unsafe ! use rtos
(and
(= (rtos (car CirOrigin1 ) 2 fuzz ) (rtos (car (cadr (nth Counter CirList ))) 2 fuzz ))
(= (rtos (cadr CirOrigin1 ) 2 fuzz ) (rtos (cadr (cadr (nth Counter CirList ))) 2 fuzz ))
(= (rtos (caddr CirOrigin1 ) 2 fuzz ) (rtos (caddr (cadr (nth Counter CirList ))) 2 fuzz ))
)
(progn
(command "._erase" (car (nth Counter CirList )) "" )
(setq CirList (vl-remove (nth Counter CirList ) CirList ) )
(setq Hit T )
)
(setq Counter (1+ Counter ) )
)
)
(if Hit (command "._erase" CirName1 "" ) (setq Index (1+ Index ) ) )
(setq Hit nil )
)
)
(princ "Nothing selected !")
)

(setvar "CLAYER" OldLay )
(command "_.UNDO" "End" )
(setq *error* OldErr )
(princ "\n\n: ) Happy Computing ! kennet\n" )
(princ)
)

I know there is sometimes a small loop counting problem, but it may bee a big helping hand anyway. . .
: ) Happy computing !

kennet

[ricodominguez]

kennet.sjoberg

that is exactly what i was hoping for
thanks alot for all your help

[keelay711]

Thats a great idea for a lisp. Im on a 3D job right now, so I thought I would give it a try. But I came up with the following error upon load:

Command: appload
NotConnected.lsp successfully loaded.
Command: ; error: misplaced dot on input

Im running CAD 2005 (current patch). Just curious if yall were running into the same problem, or maybe I'm just a doofas today.

[kennet.sjoberg]

keelay711, try again and do it with care..

I can not handle it right now I´m talking in my mobile and driving my BMW in a hard 3D turn . . .

: ) Happy Computing !

kennet

[kennet.sjoberg]

Hi Rico, the program is updated and do now handle UCS/WCS and a few more object types
also the loop counting problem is solved. Enjoy. . .

(defun c:NotConnected (/ OldErr SelSet OldLay Counter EntName EntDxf End1 End2
CirList SelSetCir CirDxf Index Cir1 CirName1 CirOrigin1 fuzz Hit )

;;; The program create circles on layer "CIRCLES" on all selected objects endpoints,
;;; then erase all equal created circles,
;;; left is circles on free endpoints. . . NotConnected objects. . .

;;;__Errorhandler__
(defun NotConnected_err ( msg / )
(if (= (getvar "ERRNO" ) 52 ) (princ "Function cancelled by User [Esc] !" ) ( ) )
(command "_.UNDO" "End" )
(command "_.U" )
(setq *error* OldErr )
(princ)
)

;;; *** MAIN ***
(command "_.UNDO" "BEgin" )
(setq OldErr *error* *error* NotConnected_err )

;;; Create circles on all endpoints
(prompt "\nCommand : Select objects to examine : " )
(if (setq SelSet (ssget ) )
(progn
(setq OldLay (getvar "CLAYER" ) )
(if (= (tblsearch "LAYER" "CIRCLES") nil )
(command "layer" "n" "CIRCLES" "c" "1" "CIRCLES" "lt" "continuous" "CIRCLES" "" )
( )
)
(setvar "CLAYER" "CIRCLES" )
(setq Counter 0 )
(setq EntName (ssname SelSet Counter ) )
(while EntName
(setq EntDxf (entget EntName ) )
(cond
((= (cdr (assoc 0 EntDxf )) "LINE" ) (setq End1 (cdr (assoc 10 EntDxf )) End2 (cdr (assoc 11 EntDxf ))) )
((= (cdr (assoc 0 EntDxf )) "RAY" ) (setq End1 (cdr (assoc 10 EntDxf )) ) )
((= (cdr (assoc 0 EntDxf )) "LWPOLYLINE" ) (setq End1 (cdr (assoc 10 EntDxf )) End2 (cdr (assoc 10 (reverse EntDxf )))) )
((= (cdr (assoc 0 EntDxf )) "ARC" ) (setq End1 (polar (cdr (assoc 10 EntDxf )) (cdr (assoc 50 EntDxf )) (cdr (assoc 40 EntDxf )))
End2 (polar (cdr (assoc 10 EntDxf )) (cdr (assoc 51 EntDxf )) (cdr (assoc 40 EntDxf )))) )
((= (cdr (assoc 0 EntDxf )) "SPLINE" ) (setq End1 (cdr (assoc 10 EntDxf )) End2 (cdr (assoc 11 (reverse EntDxf )))) )
((= (cdr (assoc 0 EntDxf )) "MLINE" ) (setq End1 (cdr (assoc 11 EntDxf )) End2 (cdr (assoc 11 (reverse EntDxf )))) )
((= (cdr (assoc 0 EntDxf )) "POLYLINE" ) (progn (setq EntName (cdr (assoc -1 EntDxf )) )
(setq EntDxf (entget (setq EntName (entnext EntName ))) )
(while (= (cdr (assoc 0 EntDxf )) "VERTEX" )
(if (not End1 ) (setq End1 (cdr (assoc 10 EntDxf ))) (setq End2 (cdr (assoc 10 EntDxf ))) )
(setq EntDxf (entget (setq EntName (entnext EntName )))))) )
(t nil)
)
(if (= (cdr (assoc 70 EntDxf )) 1 ) (setq End1 nil End2 nil ) ( ) ) ; ignore closed poly
(if End1 (command "._circle" (trans End1 0 1 ) (* 10 (getvar "DIMSCALE" )) ) ( ) )
(if End2 (command "._circle" (trans End2 0 1 ) (* 10 (getvar "DIMSCALE" )) ) ( ) )
(setq End1 nil End2 nil )
(setq Counter (1+ Counter ) )
(setq EntName (ssname SelSet Counter ) )
)

;;; Erase all circles with same coordinates
(setq CirList (list nil ) )
(setq SelSetCir (ssget "_X" '((0 . "CIRCLE" )(8 . "CIRCLES" ))) )
(setq Counter 0 )
(repeat (sslength SelSetCir )
(setq CirDxf (entget (ssname SelSetCir Counter )) )
(setq CirList (append CirList (list (list (cdr (assoc -1 CirDxf )) (cdr (assoc 10 CirDxf ))))) )
(setq Counter (1+ Counter ) )
)
(setq CirList (vl-remove nil CirList ) )

(while CirList
;; Allways crunch the first "compare" Circle in CirList
(setq Cir1 (nth 0 CirList ) )
(setq CirName1 (car (nth 0 CirList )) )
(setq CirOrigin1 (cadr (nth 0 CirList )) )
;; ...and remove it from the CirList
(setq CirList (vl-remove Cir1 CirList ) )
(setq fuzz 6 ) ;; Good to have, and sometimes good to change
(setq Index 0 )
;; ...and compare it with the rest Items in CirList
(while (> (length CirList ) Index )
(if ;; (equal CirOrigin1 (cadr (nth Index CirList )) ) <-- unsafe ! use rtos
(and
(= (rtos (car CirOrigin1 ) 2 fuzz ) (rtos (car (cadr (nth Index CirList ))) 2 fuzz ) )
(= (rtos (cadr CirOrigin1 ) 2 fuzz ) (rtos (cadr (cadr (nth Index CirList ))) 2 fuzz ) )
(= (rtos (caddr CirOrigin1 ) 2 fuzz ) (rtos (caddr (cadr (nth Index CirList ))) 2 fuzz ) )
)
(progn
;; ...if equal, remove the object in dwg, and the Item in CirList
(command "._erase" (car (nth Index CirList )) "" )
(setq CirList (vl-remove (nth Index CirList ) CirList ) )
(setq Hit T )
;; ...when Hit, do not step the Index
)
(setq Index (1+ Index ) ) ;; when not Hit, step to next Item in CirList
)
)
(if Hit (command "._erase" CirName1 "" ) ( ) ) ;; ...if equal(s), remove the "compare" Circle in dwg
(setq Hit nil )
) ;; Continue crunching the first "compare" Circle in CirList, until no more exist
)
(princ "Nothing selected !" )
)

(setvar "CLAYER" OldLay )
(command "_.UNDO" "End" )
(setq *error* OldErr )
(princ "\n\nCommand: Run twice on same objects to clear circles.\n : ) Happy Computing ! kennet\n" )
(princ)
)

: ) Happy Computing !

kennet

[Borg]

That program is a good one to post in the Exchange.

[keelay711]

Hey, it works! But what's even more amazing is that I am starting to understand what the code is saying =)

Thanx Kennet

[Robert.Hall]

How do you change the circle size???
This is a great routine.........I work in english units and the circles are huge.

[Mike.Perry]

Hi

The circle size is based on the current DimScale (x 10), therefore try changing your DimScale to a smaller value before running the routine.

Have a good one, Mike

[keelay711]

(if End1 (command "._circle" (trans End1 0 1 ) (* 10 (getvar "DIMSCALE" )) ) ( ) )
(if End2 (command "._circle" (trans End2 0 1 ) (* 10 (getvar "DIMSCALE" )) ) ( ) )

If you edit the above code slightly, you can change the circle size without having reset your dimscale. For simplicity, try replacing 10 with 1.

Thank again Kennet!

[kennet.sjoberg]

I must say that I am glad that so many is interested in my code of NotConnected....

mike.13525 Thanks for Your response
keelay711 I am amazing too ; )
rhall.72202 metric is a wonderful world 10 / 25.4 = 0.3937007874015748031496062992126....
Mike.Perry Thanks for changing DimScale before the code...

: ) Happy Computing !

kennet