Looking for inspiration... where to start boundary + layer detection

[Aftertouch]

Hello all,

I got a DWG with alot of lines on different layers.

Now i need to generate boundary inbetween these lines.

 

To speed up this proces, i was thinking to make a LISP that allows me to select a point, detect the boundary, place a polyline and set it to the desired layer.

Now i was thinking to analyse the layers of the individual lines and make a logic to determine the layer my new boundary should get.

 

Sooo... my logic would be...

pick a point

Create a boundary

Detect layers

make the logic

assign the layer to the new boundary.

 

But....

How in the world can i detect all the lines/polylines that AutoCAD uses to make a boundary and put them in a selectionset for analysis?

Any suggestions, inspiration?

 

EDIT:

Added an DWG as example of what im looking for.

But... not asking for a whole script, just a way to be able to detect the 'touching-edges' efficiently.

demo.dwgFetching info...

Edited Wednesday at 07:42 AM by Aftertouch

[GLAVCVS]

Hi @Aftertouch

Assuming there are a series of concatenated lines/polylines that will allow the boundary to be generated, the logic or algorithm could be:
1- Obtain the created boundary by calling 'entlast'
2- Obtain its points
3- Select the lines/polylines that match the first point of the boundary with 'ssget'
4- Analyze the selected lines or polylines and check which ones match the boundary at all points

From here, a loop...

5- Repeat step 3 with the start or end point (whichever is different from the previous one) of the polyline selected in step 4
6- Repeat step 4

This could be the simplest algorithm (although not the most efficient)

[Aftertouch]

@GLAVCVS

Thanks for the suggestion.

Step 4 wont work im afraid, since i got situations like a 'tick-tac-to' grid, so matching the points with long lines will be hard.

 

But.... i can determine the midpoint of each segment of the generated boundary, and use an ssget 'window' so select the line on the midpoint... from there on, collect all lines based on midpoints.... I think thatll too.

 

Thanks again! This helped alot.

[GLAVCVS]

If there are special situations, then I think it is better for you to post an example drawing.

[BIGAL]

Yes as suggested post a dwg, you may be able to use SSGET "F" where it uses the boundary points to get objects that touch the boundary. PS check Bpoly command. 

[Aftertouch]

Hello all,

 

I added a DWG to my first post as a sample.

Please not that im looking looking for a effective way to determine the layer-logic..

The rest of the script is my own challenge.

[GLAVCVS]

If what you mean is that the boundaries will be created from lines that intersect but have no points in common, then one option is to do as you say, selecting the midpoint of each segment. However, to confirm which of them the boundary point lies on, I would check if the equation of the line segment of the selected line matches that of the boundary segment.

[Aftertouch]

Yes, i got a working solution for now!

Inspired by @GLAVCVS

 

Still work in proges.

But 'objects on midpoints' returns me the layers on a segment of the boundary.

I will collect all there layers on the boundarys, so i cna work with the following logic.

 

	(command "CIRCLE" "0,0" "1")
	(setq saveent (entlast))

	(setq pickedpoint (getpoint "\nSELECT POINT"))
	(command "-BOUNDARY" pickedpoint "")
	(setq newent (entlast))
	(if (eq saveent newent)
		(progn
			(princ "\nFailed to create boundary!")
		)
		(progn
			(princ "\nHurray!")
			(command "EXPLODE" (entlast))
			(setq ss (ssget "_P"))

			(if (not ss)
				(progn
					(princ "\nSoomething when wrong!")
				)
				(progn
					(setq i 0)
					(repeat (sslength ss)
						(setq refensel (ssname ss i))
						(setq refpoint (GPAE:MIDOFOBJECT (ssname ss i)))
						(command "ERASE" refensel "")
						(setq objectsonmidpoints (ssget "_CP" (list (mapcar '+ refpoint (list -0.1 -0.1 0)) (mapcar '+ refpoint (list -0.1 0.1 0)) (mapcar '+ refpoint (list 0.1 0.1 0)) (mapcar '+ refpoint (list 0.1 -0.1 0))) (list (cons 0 "LWPOLYLINE"))))

						(setq i (+ 1 i))
					)
				)
			)
		)
	)

	(command "ERASE" saveent "")

 

[GLAVCVS]

In any case, an approach that selects from each vertex of the boundary and filters the results based on the equation of the line would be somewhat more efficient because each selection would cover two segments.
So, if you want to up the ante on your challenge, you can try doing it this way.

[Aftertouch]

Hi all,

 

Its alive!

 

For now, its 4 commands:

 

BOUNDARY-FROM-ALL-BLOCKS

This tool determines the corresponding boundary based on the centroids of all blocks.
This layer is assigned the layer name of the block so that the material properties are also transferred.

 

BOUNDARY-FROM-BLOCKS

Same as the above, but the user selects a block manually.
This gives more control over which blocks should or should not be used.

 

BOUNDARY-MOST-COMMON

The user selects a point within a surface, and the boundary is determined.
Based on all detected contour lines, the ‘most common’ boundary line is used as the leading layer.

 

BOUNDARY-VARIABLE

The user selects a point within a surface, and the boundary is determined.
Based on all detected contour lines, a selection list is generated, allowing the user to choose the desired layer.
This provides a more controlled version of the ‘most common’ variant.

 

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun C:BOUNDARY-MOST-COMMON ( / *error* )
	(defun *error* ( msg )
		(LOCAL:RESTOREVARIABLES)
		(LOCAL:ENDUNDO (LOCAL:ACTIVEDOCUMENT))
		(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
			(progn
				(alert "Something went wrong!")
				(alert (strcat "Error: " msg))
			)
		)
	(princ)
	)

	(vl-load-com)
	(LOCAL:STARTUNDO (LOCAL:ACTIVEDOCUMENT))
	(LOCAL:STOREVARIABLES '("CMDECHO" "OSMODE"))
	(setvar "CMDECHO" 0)
	(setvar "OSMODE" 0)

	(CREATEBOUNDARY 0 nil nil)

	(LOCAL:RESTOREVARIABLES)
	(LOCAL:ENDUNDO (LOCAL:ACTIVEDOCUMENT))

(princ)
)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun C:BOUNDARY-VARIABLE ( / *error* )
	(defun *error* ( msg )
		(LOCAL:RESTOREVARIABLES)
		(LOCAL:ENDUNDO (LOCAL:ACTIVEDOCUMENT))
		(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
			(progn
				(alert "Something went wrong!")
				(alert (strcat "Error: " msg))
			)
		)
	(princ)
	)

	(vl-load-com)
	(LOCAL:STARTUNDO (LOCAL:ACTIVEDOCUMENT))
	(LOCAL:STOREVARIABLES '("CMDECHO" "OSMODE"))
	(setvar "CMDECHO" 0)
	(setvar "OSMODE" 0)

	(CREATEBOUNDARY 1 nil nil)

	(LOCAL:RESTOREVARIABLES)
	(LOCAL:ENDUNDO (LOCAL:ACTIVEDOCUMENT))

(princ)
)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun C:BOUNDARY-FROM-BLOCK ( / *error* en blockloc blocklay)
	(defun *error* ( msg )
		(LOCAL:RESTOREVARIABLES)
		(LOCAL:ENDUNDO (LOCAL:ACTIVEDOCUMENT))
		(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
			(progn
				(alert "Something went wrong!")
				(alert (strcat "Error: " msg))
			)
		)
	(princ)
	)

	(vl-load-com)
	(LOCAL:STARTUNDO (LOCAL:ACTIVEDOCUMENT))
	(LOCAL:STOREVARIABLES '("CMDECHO" "OSMODE"))
	(setvar "CMDECHO" 0)
	(setvar "OSMODE" 0)

	(while (not (and (setq en (entsel "\nSelecteer block... "))(= (cdr (assoc 0 (entget (car en)))) "INSERT"))))
	(if en
		(progn
			(setq blockloc (cdr (assoc 10 (entget (car en)))))
			(setq blocklay (cdr (assoc 8 (entget (car en)))))
			(CREATEBOUNDARY nil blockloc blocklay)
		)
	)

	(LOCAL:RESTOREVARIABLES)
	(LOCAL:ENDUNDO (LOCAL:ACTIVEDOCUMENT))

(princ)
)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun C:BOUNDARY-FROM-ALL-BLOCKS ( / *error* en blockloc blocklay)
	(defun *error* ( msg )
		(LOCAL:RESTOREVARIABLES)
		(LOCAL:ENDUNDO (LOCAL:ACTIVEDOCUMENT))
		(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
			(progn
				(alert "Something went wrong!")
				(alert (strcat "Error: " msg))
			)
		)
	(princ)
	)

	(vl-load-com)
	(LOCAL:STARTUNDO (LOCAL:ACTIVEDOCUMENT))
	(LOCAL:STOREVARIABLES '("CMDECHO" "OSMODE"))
	(setvar "CMDECHO" 0)
	(setvar "OSMODE" 0)

	(setq selset (ssget "_X" (list (cons 0 "INSERT"))))
	(if selset
		(progn
			(setq counti 0)
			(repeat (sslength selset)
				(setq loopent (ssname selset counti))
				(setq blockloc (cdr (assoc 10 (entget loopent))))
				(setq blocklay (cdr (assoc 8 (entget loopent))))
				(CREATEBOUNDARY nil blockloc blocklay)
				(setq counti (+ 1 counti))
			)
		)
	)

	(LOCAL:RESTOREVARIABLES)
	(LOCAL:ENDUNDO (LOCAL:ACTIVEDOCUMENT))

(princ)
)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun CREATEBOUNDARY ( mode xyz lay / *error* pickedpoint oldosmode oldcmdecho saveent newent ss i ii objectsonmidpoints midensel midensellay layerlist newlayers newlayer resultvalue)

	(if (not xyz)
		(setq pickedpoint (getpoint "\nSpecify internal point: "))
		(setq pickedpoint xyz)
	)

	(command "CIRCLE" "0,0" "1")
	(setq saveent (entlast))

	(command "-BOUNDARY" pickedpoint "")
	(setq newent (entlast))
	(if (eq saveent newent)
		(progn
			;(princ "\nFailed to create boundary!")
		)
		(progn
			;(princ "\nHurray!")

			(if lay
				(progn
					(command "ERASE" newent "")
					(command "-LAYER" "MAKE" (strcat lay "-GV") "COLOR" "6" "" "")
					(command "-BOUNDARY" pickedpoint "")
				)
				(progn
					(command "EXPLODE" (entlast))
					(setq ss (ssget "_P"))

					(if (not ss)
						(progn
							(princ "\nOm onbekende redenen is er iets misgegaan!")
						)
						(progn
							(setq i 0)
							(repeat (sslength ss)
								(setq refensel (ssname ss i))
								(setq refpoint (LOCAL:MIDOFOBJECT (ssname ss i)))
								(command "ERASE" refensel "")
								(setq objectsonmidpoints (ssget "_CP" (list (mapcar '+ refpoint (list -0.1 -0.1 0)) (mapcar '+ refpoint (list -0.1 0.1 0)) (mapcar '+ refpoint (list 0.1 0.1 0)) (mapcar '+ refpoint (list 0.1 -0.1 0))) (list (cons 0 "LINE,ARC,CIRCLE,LWPOLYLINE")(cons 8 "~*GV"))))

								(setq ii 0)
								(if objectsonmidpoints
									(progn
										(setq midensel (ssname objectsonmidpoints ii))
										(setq midensellay (cdr (assoc 8 (entget midensel))))
										(setq layerlist (cons midensellay layerlist))
										(setq ii (+ 1 ii))
									)
								)

								(setq i (+ 1 i))
							)

							(if layerlist
								(progn
									;; MODE 0 zorgt dat er een keuzemenu komt als er geen 'meer voorkomende' layer is.
									;; MODE 1 zorgt ervoor dat er altijd een keuze menu komt als er meer dan 1 layer gevonden is.
									(cond
										((= mode 0)
											(setq newlayers (LOCAL:MOST-COMMON layerlist))
										)
										((= mode 1)
											(setq newlayers (LM:Unique layerlist))
										)
										((= mode 2)
										;;;;;	(setq newlayers (LM:Unique layerlist))
										)	
									)

									(if (= (length newlayers) 1)
										(progn
											(setq resultvalue (nth 0 newlayers))
											(command "-LAYER" "MAKE" (strcat resultvalue "-GV") "COLOR" "6" "" "")
											(command "-BOUNDARY" pickedpoint "")
										)
										(progn
											(BOUNDARYPICKLAYER newlayers)
											(if resultvalue
												(progn
													;(alert (strcat "NEWBOUNDARY MET LAYER " resultvalue))
													(command "-LAYER" "MAKE" (strcat resultvalue "-GV") "COLOR" "6" "" "")
													(command "-BOUNDARY" pickedpoint "")
												)
											)
										)
									)
								)
							)
						)
					)
				)
			)
		)
	)

	(command "ERASE" saveent "")
)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun LM:CountItems ( l / c x )
    (if (setq x (car l))
        (progn
            (setq c (length l)
                  l (vl-remove x (cdr l))
            )
            (cons (cons x (- c (length l))) (LM:CountItems l))
        )
    )
)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun LOCAL:MIDOFOBJECT ( object / )
	(vlax-curve-getpointatparam object (/ (+ (vlax-curve-getstartparam object) (vlax-curve-getendparam object)) 2.0))
)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun LOCAL:MOST-COMMON (lst / unique counts max-val max-keys)
	(setq unique '() counts '())
	(foreach item lst
		(if (not (member item unique))
			(setq unique (cons item unique))
		)
	)

	(foreach u unique
		(setq counts (cons (list u (apply '+ (mapcar '(lambda (x) (if (equal x u) 1 0)) lst))) counts))
	)

	(setq max-val 0 max-keys '())
		(foreach item counts
			(cond
				((> (cadr item) max-val)  ;; Found a new highest count
					(setq max-val (cadr item)
					max-keys (list (car item))))
				((= (cadr item) max-val)  ;; Found another with the same highest count
					(setq max-keys (cons (car item) max-keys))
				)
			)
		)

	 max-keys
)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun LM:Unique ( l )
    (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun BOUNDARYPICKLAYER ( newlayers / *error* dcl_content dcl_contentmiddle dcl_content2 dcl_filename dcl_id tabellen_options pickresult )
		;; DCL BOUWEN
		  (setq dcl_content
		    "picklist_dialog : dialog {
			  label = \"Kies een layer voor de boundary\";
			  : column {
			    ")
			   (setq dcl_contentmiddle "")
		  		 (setq dcl_contentmiddle
			      (strcat dcl_contentmiddle ": row {
	   	    		 : column {
				          : text {
				            label = \"Gevonden layers\";
				            key = \"Tabellen\";
				          }
		   		       : popup_list {
		      		          key = \"tabellen_list\";
		  		          width = 60;
		  		          popup_list_height = 6;
		  		        }
				        }
				   }"))
			  (setq dcl_content2
			    "}
			    : spacer {}
			    : row {
			      : button {
			        label = \"OK\";
			        key = \"accept\";
			        is_default = true;
			      }
			      : button {
			        label = \"Cancel\";
			        key = \"cancel\";
			      }		   
			  }
			}")

		;; Define the temporary DCL file path
		(setq dcl_filename (strcat (getvar "TEMPPREFIX") "picklist_temp.dcl"))

		;; Create and write the DCL content to the temporary file
		(setq dcl_id (open dcl_filename "w"))
		(if dcl_id
			(progn
				(write-line (strcat dcl_content dcl_contentmiddle dcl_content2) dcl_id)
				(close dcl_id)
			)
			(progn
				(princ "\nError: Unable to create temporary DCL file.")
				(exit)
			)
		)

		;; Load the temporary DCL file
		(setq dcl_id (load_dialog dcl_filename))
		(if (not (new_dialog "picklist_dialog" dcl_id))
			(progn
				(princ "\nError: Unable to load dialog.")
				;(exit)
			)
		)

		;; Define picklist contents in LISP
		(setq tabellen_options newlayers)

		;; Load the content of each picklist
		(start_list "tabellen_list")
		(mapcar 'add_list tabellen_options)
		(end_list)

		;; Define actions for the dialog
		(action_tile "accept" "(progn
			(setq pickresult (nth (atoi (get_tile \"tabellen_list\")) (eval (read \"tabellen_options\"))))
			(done_dialog 1)
		)")
	
		(action_tile "cancel" "(progn
			(done_dialog 0)
		)")
 
		;; Intercept the close button action (X button)
		(action_tile "close" "(progn
			(done_dialog 0)
		)")

		;; Start the dialog
		(start_dialog)

		;; Unload the dialog and delete the temporary DCL file
		(unload_dialog dcl_id)
		(vl-file-delete dcl_filename)

		(if (not pickresult)
			(progn
				(alert "Geen keuze gemaakt!")
			)
			(progn
				(setq resultvalue pickresult)		
			)
		)

	resultvalue
)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun LOCAL:ACTIVEDOCUMENT ( / )
    (vla-get-activedocument (vlax-get-acad-object))
)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun LOCAL:STARTUNDO ( doc / )
    (LOCAL:ENDUNDO doc)
    (vla-startundomark doc)
)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun LOCAL:ENDUNDO ( doc / )
    (if (= 8 (logand 8 (getvar "UNDOCTL")))
        (vla-endundomark doc)
    )
)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun LOCAL:STOREVARIABLES ( variables / )
	(foreach x variables (setq storedvariables (cons (list x (getvar x)) storedvariables)))
	(if (lspICDIsEventToggleEnabled)(setq infracadenabled "T")(setq infracadenabled nil))

)

;;--------------------------------------------;;
;;--------------------------------------------;;

(defun LOCAL:RESTOREVARIABLES ( / )
	(foreach x storedvariables (if (/= (car x) "")(setvar (car x)(cadr x))))
	(setq storedvariables nil)
	(if infracadenabled (lspICDEnableEventToggle)(lspICDDisableEventToggle))
	(setq infracadenabled nil)

)

;;--------------------------------------------;;
;;--------------------------------------------;;

(princ)

;;--------------------------------------------;;
;;--------------------------------------------;;