I need LISP routine to move all utility lines polylines or lines to the respected layer read from the multileader text

[asalmanULQ8G]

Im trying to add 5 or 6-digit numeric ID value found in multileaders text then try to match it with the closest polyline based on arrow head location or insertion add it to the layer name of that line or polyline as a suffix, any help would be appreciated.

(defun c:MovePolylinesToLayer (/ ssMleaders ssEntities i Mle MleText layerName allEntities closestEnt entPos leaderVertices)
;; Function to find the closest entity to a point
(defun getClosestEntity (point entities / closestEnt closestDist dist entPos)
(setq closestEnt nil
closestDist nil)
(foreach ent entities
(setq entPos (getEntityPosition ent))
(if entPos
(progn
(setq dist (distance point entPos))
(if (or (not closestDist) (< dist closestDist))
(setq closestEnt ent
closestDist dist)
)
)
)
)
closestEnt
)

;; Function to get the position of the entity
(defun getEntityPosition (ent)
(cond
((= (vla-get-ObjectName ent) "AcDbLine") (vlax-get ent 'StartPoint))
((or (= (vla-get-ObjectName ent) "AcDbPolyline")
(= (vla-get-ObjectName ent) "AcDb2dPolyline"))
(vlax-curve-getPointAtParam ent 0.0))
(t nil)
)
)

;; Function to get leader line vertices from MULTILEADER using DXF group code 10
(defun getLeaderVertices (Mle / entData vertices)
(setq entData (entget (vlax-vla-object->ename Mle)))
(setq vertices (mapcar 'cdr (vl-remove-if-not
'(lambda (pair) (= (car pair) 10))
entData)))
(if (null vertices)
(progn
(prompt "\nError: No leader line vertices found.")
nil
)
vertices
)
)

;; Main routine
(if (and (setq ssMleaders (ssget '((0 . "MULTILEADER"))))
(setq ssEntities (ssget '((0 . "LWPOLYLINE,POLYLINE,LINE"))))
(> (sslength ssMleaders) 0)
(> (sslength ssEntities) 0))
(progn
(repeat (setq i (sslength ssMleaders))
(setq Mle (vlax-ename->vla-object (ssname ssMleaders (setq i (1- i)))))
(setq MleText (vla-get-TextString Mle))

;; Construct layer name from MULTILEADER text
(setq layerName (strcat "UID-" (vl-string-translate " " "_" MleText)))

;; Create a new layer if it does not exist
(if (null (tblsearch "Layer" layerName))
(entmake (append
(list (cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 layerName)
(cons 70 0)
(cons 62 7)) ;; Default layer color (white)
))
)

;; Get the leader line vertices
(setq leaderVertices (getLeaderVertices Mle))
(if (and leaderVertices (not (equal leaderVertices '())))
(progn
(setq entPos (car leaderVertices)) ;; Get the first vertex
(prompt (strcat "\nLeader position: " (vl-prin1-to-string entPos)))

;; Find all entities (polylines and lines)
(setq allEntities (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssEntities)))))

;; Find the closest entity to the MULTILEADER
(setq closestEnt (getClosestEntity entPos allEntities))

;; If a closest entity is found, move it to the layer
(if closestEnt
(progn
(vla-put-Layer closestEnt layerName)
(prompt (strcat "\nMoved entity to layer: " layerName))
)
(prompt "\nNo closest entity found.")
)
)
(prompt "\nError: No leader line vertices found.")
)
)
)
(prompt "\nNo multileaders or entities found.")
)

(princ "\nMovePolylinesToLayer command completed.")
(princ)
)

(princ "\nMovePolylinesToLayer command loaded.")
(princ)

Im getting this error when running my lisp , any help would be greatly appreciated>

getting this error Leader position: (335650.0 4.85079e+06 0.0); error: Automation Error. Key not found

@komondormrex , any help is much appreciated.

[paullimapa · Accepted solution]

The major problem you have is with the text in the mleader.

The multiline mleader text may contain formatting characters that AutoCAD would not accept as a layer name. I'd suggest you use something like Lee Mac's unformat string function to get rid of these formatting characters first before passing it to making the layer.

Likewise Layer names cannot contain any commas ",".

So that would mean you'll need to replace commas with a supported character like a dash "-" like:

(setq layerName (vl-string-translate "," "-" layerName)))

You can test your lines of code by copy & pasting them onto AutoCAD's command line. This is how I ended up finding out the layer name character problems.

[komondormrex · Accepted solution]

hey there,

that and the main error you got because your mleaders' mtext  is specially formatted, thus getting that text as eg.
"\\A1;{\\Fsimplex8|c0;\\C256;11441-FOC-ZAYO-QLD AS PER \\A0;\\Fromans|c0;\\C2;ZAYO_UNDERGROUND.shx. (NOT PROVIDED)}" will not make any prefixed layer. so [layer] key  not found.

you need to clear text formatting beforehand.

[asalmanULQ8G]

thanks for that I will try a workaround to export to csv then do the formatting as I think the text is not consistent

[paullimapa]

No need to do the export to csv workaround when you can implement lisp code to clean up the mleader formats

[asalmanULQ8G]

thanks after trying on a simpler version I am still getting this error :

Leader position: 342439.0; error: bad argument type: lentityp #<VLA-OBJECT IAcadLWPolyline 000002cd6a4936d8>

I think it has to do with multileaders linework or if it 3D polylines

[paullimapa]

Share your dwg with the simpler version and the revised code

[asalmanULQ8G]

I managed to get this working however I cannot loop through all the Multileaders with ssget 

(defun LM:UnFormat (str mtx / _replace rx)
;; Function to remove MText formatting codes, adapted from Lee Mac's logic
(defun _replace (new old str)
(vlax-put-property rx 'pattern old)
(vlax-invoke rx 'replace str new)
)
(if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
(progn
(setq str
(vl-catch-all-apply
(function
(lambda ()
(vlax-put-property rx 'global actrue)
(vlax-put-property rx 'multiline actrue)
(vlax-put-property rx 'ignorecase acfalse)
(foreach pair
'(
("\032" . "\\\\\\\\")
(" " . "\\\\P|\\n|\\t")
("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
("$1" . "[\\\\]({)|{")
)
(setq str (_replace (car pair) (cdr pair) str))
)
(if mtx
(_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
(_replace "\\" "\032" str)
)
)
)
)
)
(vlax-release-object rx)
(if (null (vl-catch-all-error-p str))
str
)
)
)
)
(vl-load-com)

(defun c:ReplaceSpecialCharsInMultileader ( / ent obj mtext cleanedText)
;; Prompt user to select a Multileader
(setq ent (car (entsel "\nSelect a Multileader: ")))
(if (and ent (eq (cdr (assoc 0 (entget ent))) "MULTILEADER"))
(progn
;; Get the Multileader object and its text content
(setq obj (vlax-ename->vla-object ent))
(setq mtext (vla-get-TextString obj))

;; Unformat the text to remove formatting codes
(setq mtext (LM:UnFormat mtext T))

;; Replace special characters with underscores
(setq cleanedText (vl-string-subst "_" "\\" mtext))
(setq cleanedText (vl-string-subst "_" "/" cleanedText))
(setq cleanedText (vl-string-subst "_" ":" cleanedText))
(setq cleanedText (vl-string-subst "_" "," cleanedText))
(setq cleanedText (vl-string-subst "_" ";" cleanedText))
(setq cleanedText (vl-string-subst "_" "." cleanedText))
(setq cleanedText (vl-string-subst "_" "(" cleanedText))
(setq cleanedText (vl-string-subst "_" ")" cleanedText))
(setq cleanedText (vl-string-subst "_" "$" cleanedText))
(setq cleanedText (vl-string-subst "_" "@" cleanedText))
(setq cleanedText (vl-string-subst "_" "#" cleanedText))
(setq cleanedText (vl-string-subst "_" "*" cleanedText))
(setq cleanedText (vl-string-subst "_" "&" cleanedText))

;; Update the Multileader with the modified text
(vla-put-TextString obj cleanedText)

;; Print the result
(princ "\nMultileader text updated successfully.")
)
(princ "\nSelected entity is not a Multileader.")) ;; Handle the case where the selected entity is not a Multileader
(princ)
)

[paullimapa]

since you're using the entsel function that only allows you to select one object at a time:

;; Prompt user to select a Multileader
(setq ent (car (entsel "\nSelect a Multileader: ")))

was there a problem using your previous code to select multileaders, clean the formatting of the text and then continuing to make the layer and etc?

(setq ssEntities (ssget '((0 . "LWPOLYLINE,POLYLINE,LINE"))))
(> (sslength ssMleaders) 0)
(> (sslength ssEntities) 0))
(progn
(repeat (setq i (sslength ssMleaders))
(setq Mle (vlax-ename->vla-object (ssname ssMleaders (setq i (1- i)))))
(setq MleText (vla-get-TextString Mle))

now you just run your unformat &  cleantext code and then you can continue with the remainder of your original code:

;; Construct layer name from MULTILEADER text
(setq layerName (strcat "UID-" (vl-string-translate " " "_" MleText)))

;; Create a new layer if it does not exist
(if (null (tblsearch "Layer" layerName))
(entmake (append
(list (cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 layerName)
(cons 70 0)
(cons 62 7)) ;; Default layer color (white)
))
)

[komondormrex · Accepted solution]

apart from getting rid of a layer name formatting check this mod of your code. only mleaders have to be selected. 

(defun c:MovePolylinesToLayer (/ ssMleaders ssEntities Mle MleText layerName allEntities closestEnt mleader_tip_point)
	;; Function to find the closest entity to a point
	(defun getClosestEntity (point entities_list)
		(car (vl-sort entities_list 
					'(lambda (entity_1 entity_2) (< (distance point (vlax-curve-getclosestpointto entity_1 point))
													(distance point (vlax-curve-getclosestpointto entity_2 point))
												 )
					 )
			 )
		)
	)
	;; Function to get mleader root vertex
	(defun get_mleader_root (mle / first_line_raw_cordinates)
		(setq first_line_raw_cordinates (vlax-invoke mle 'getleaderlinevertices 0))
		(list (car first_line_raw_cordinates) 
			(cadr first_line_raw_cordinates) 
			(caddr first_line_raw_cordinates) 
		)
	)
	;; Main routine
	(if (and (setq ssMleaders (ssget '((0 . "MULTILEADER"))))
			 (setq ssEntities (ssget "_x" '((0 . "LWPOLYLINE,POLYLINE,LINE"))))
			 (> (sslength ssMleaders) 0)
			 (> (sslength ssEntities) 0)
		)
		(progn
			(setq ssEntities_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssEntities))))) 
			(foreach mle (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssMleaders)))) 
				(setq MleText (vla-get-TextString Mle))
				;; Construct layer name from MULTILEADER text
				(setq layerName (strcat "UID-" (vl-string-translate " " "_" MleText)))
				;; Create a new layer if it does not exist
				(if (null (tblsearch "Layer" layerName))
					(entmake (append
								(list (cons 0 "LAYER")
								(cons 100 "AcDbSymbolTableRecord")
								(cons 100 "AcDbLayerTableRecord")
								(cons 2 layerName)
								(cons 70 0)
								(cons 62 7)) ;; Default layer color (white)
							 )
					)
				)
				;; Get the leader line vertices
				(setq mleader_tip_point (get_mleader_root mle))
				(prompt (strcat "\nLeader tip position: " (vl-prin1-to-string mleader_tip_point)))
				(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Layer (list (setq closest_entity (getClosestEntity mleader_tip_point ssEntities_list)) layerName)))
					(princ (strcat "\nSomething is definitely wrong with the \"" layername "\" layer"))
					(prompt (strcat "\nMoved entity to layer: " layerName))
				)
				(setq ssEntities_list (vl-remove closest_entity ssEntities_list))  
			)
		)
		(prompt "\nNo multileaders or entities found.")
	)
	(princ "\nMovePolylinesToLayer command completed.")
	(princ)
)
(princ "\nMovePolylinesToLayer command loaded.")
(princ)