Set MLeader to Existing MLeader Style via LISP

December 11, 2012

Hello,

I am trying to create a lisp routine that sets all existing MLEADERs to a certain pre-set MLEADERSTYLE, the equivalent of doing a Quick Select for Mleaders, and setting the style under the properties window.

I was able to write a similar routine that selects all dimensions and sets them to a certain DIMSTYLE, using entmod and DXF code 3 for dimstyle. So far, I have not been able to find a group code for MLEADERSTYLE

Any help would be greatly appreciated!

(defun C:dimstylechange (/ ENTITIES NO_OF_ENTITIES SSPOSITION ENTITY_NAME
OLD_ENTLIST NEW_STYLE NEW_ENTLIST)

(setvar "CMDECHO" 0)
(setq ENTITIES (ssget "X" '((0 . "DIMENSION"))))
(setq NO_OF_ENTITIES (sslength ENTITIES))
(setq SSPOSITION 0)
(repeat NO_OF_ENTITIES

;***CHANGE STYLE***
(setq ENTITY_NAME (ssname ENTITIES SSPOSITION))
(setq OLD_ENTLIST (entget ENTITY_NAME))
(setq OLD_STYLE (assoc 3 OLD_ENTLIST))
(setq NEW_STYLE (cons 3 "BCR 11x17"))
(setq NEW_ENTLIST (subst NEW_STYLE OLD_STYLE OLD_ENTLIST))

(entmod NEW_ENTLIST)


;***CHANGE LAYER***
(setq OLD_ENTLIST (entget ENTITY_NAME))
(setq OLD_STYLE (assoc 8 OLD_ENTLIST))
(setq NEW_STYLE (cons 8 "DIM"))
(setq NEW_ENTLIST (subst NEW_STYLE OLD_STYLE OLD_ENTLIST))

(entmod NEW_ENTLIST)

(setq SSPOSITION (1+ SSPOSITION))
)

(command ".CHPROP" ENTITIES "" "C" "BYLAYER" "LT" "BYLAYER" "")

(princ (strcat "\n..." (rtos NO_OF_ENTITIES 2 0) " Dimension(s) changed..."))
(setvar "CMDECHO" 1)
(princ)
)

dimstylechange.LSP

Edited December 11, 2012 by parkerdepriest

December 11, 2012

Welcome to CADTutor!

(vl-load-com)

(defun c:FOO (/ ss styleName)
 (if (and (setq ss (ssget "_x" '((0 . "MULTILEADER"))))
          (dictsearch
            (namedobjdict)
            "ACAD_MLEADERSTYLE"
            (setq styleName [color=red]"YourMLeaderStyleName"[/color])
          )
     )
   (progn
     (vlax-for x (setq ss
                        (vla-get-activeselectionset
                          (vla-get-activedocument (vlax-get-acad-object))
                        )
                 )
       (vla-put-stylename x styleName)
     )
     (vla-delete ss)
   )
   (cond (ss (prompt "\n** MLeader style name not found ** "))
         ((prompt "\n** No MLeaders selected ** "))
   )
 )
)

December 11, 2012

Works perfectly! Thank you!

December 11, 2012

Works perfectly! Thank you!

You're welcome; I'm happy to help.

Separately - You'd do well to edit your Original Post (OP) to include

, so as to not upset SLW, you wouldn't like him when he's angry.

December 11, 2012

Not to detract from a good solution, but note that the following will always return the ACAD_MLEADERSTYLE Dictionary (i.e. a non-nil result), regardless of the string value returned by the setq expression.

([color=blue]dictsearch[/color]
 ([color=blue]namedobjdict[/color])
 [color=darkred]"ACAD_MLEADERSTYLE"[/color]
 ([color=blue]setq [/color]styleName [color=darkred]"YourMLeaderStyleName"[/color])
)

The third 'setnext' parameter of the dictsearch function is purely a flag to control the result returned upon evaluating dictnext following the dictsearch expression. If 'setnext' is non-nil, the dictnext entry counter is altered to ensure that any subsequent dictnext evaluation returns the dictionary entry after the symbol supplied to the dictsearch function.

To test for the existence of an MLeaderStyle, I would suggest something along the lines of:

([color=blue]and[/color]
   ([color=blue]setq [/color]dic ([color=blue]dictsearch [/color]([color=blue]namedobjdict[/color]) [color=darkred]"ACAD_MLEADERSTYLE"[/color]))
   ([color=blue]dictsearch [/color]([color=blue]cdr [/color]([color=blue]assoc [/color]-1 dic)) [color=darkred]"YourMLeaderStyleName"[/color])
)

Or, if guaranteed to be evaluated in versions of AutoCAD in which MLeaders are available:

([color=blue]dictsearch[/color]
   ([color=blue]cdr [/color]([color=blue]assoc [/color]-1 ([color=blue]dictsearch [/color]([color=blue]namedobjdict[/color]) [color=darkred]"ACAD_MLEADERSTYLE"[/color])))
   [color=darkred]"YourMLeaderStyleName"[/color]
)

September 8, 2017

I resume this thread cause i've noted that this lisp just change all the selected ML to a certain style....

the funtcion i'm searching is that one but setting all the properties as the ML style defaults.

I Try to explain.

i.e.

I change a single property of a bunch of MLs, so not all the present in the dwg; let's say arrow size and text height.... i change them from the properties menù not from the style's prop.

I would like to use this LISP to restore all the values to the style defaults.... instead it change the style and the values changed remain the same.

I'm totally out of Lisp .. can this one be adapted to do what i'm searching for??

Thanks a lot guy!!

Bix

September 18, 2017

UP!

September 22, 2017

@bixcad:

Mleaders are very (overly) complex, IMO Autodesk's programmers went a little overboard, and not well documented.

In BricsCAD the code below is able to remove the overrides. If you want to test the code in AutoCAD: change "NewStyle" to the name of a valid new mleader style.

(defun c:Test (/ elst enm)
 (setq enm (car (entsel)))
 (setq elst (entget enm))
 (entmod (reverse (subst '(90 . 0) (assoc 90 (reverse elst)) (reverse elst))))
 (vla-put-stylename (vlax-ename->vla-object enm) "NewStyle")
 (princ)
)

September 7, 2018

On 9/18/2017 at 3:07 PM, bixcad said:

UP!

I too was P'd with this so.

Try the program below. I recreates the MLEADER in place, therefore, removing any overrides in the process. I will retain the following:

Layer
StyleName
TextWidth
TextString
TextRotation

It works with MLEADERS that have a max of 3 verts. It will skip those and give a read-out at the end.

Let me know what you think of it.

(vl-load-com)

;; ---------------------=={ MLEADER_Recreate }==--------------------------
;; -----------------------------------------------------------------------

;; AUTHOR & ADDITIONAL CODE
;; Author:					by 3dwannab, Copyright © 2018

;; ABOUT / NOTES
;; - Recreates MULTILEADER/s with 2 or 3 points
;; - This solves the issues with MLEADER styles been overridden in the properties dialog

;; FUNCTION SYNTAX
;; Short-cut				MR
;; Long-cut					MLEADER_Recreate

;; VERSION					DATE			INFO
;; Version 1.0				26-08-2018		1st draft 26-07-2018

;; TO DO LIST
;; - Maybe get it to work with more than 3 vertices.

;; -----------------------------------------------------------------------
;; ------------------=={ MLEADER_Recreate START }==-----------------------

; (defun c:--ldMLEADER_Recreate ( / ) (LOAD "MLEADER_Recreate") (c:MLEADER_Recreate))

(setq *MLEADER_Recreate-Ver* "1.0")

(defun c:MR () (c:MLEADER_Recreate))

(defun c:MR ( /
	*error*
	cnt
	en
	endata
	getLay
	getLeaderCnt
	getStyle
	getTxtRot
	getTxtStr
	getTxtWidth
	ldxf10_1
	ldxf10_2
	ldxf10_3
	lstpts
	lstptslen
	obj
	objnew
	sel
	var_cmdecho
	var_osmode
	)

(defun *error* (errmsg)
	(and acDoc (vla-EndUndoMark acDoc))
	(and errmsg
		(not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
		(princ (strcat "\n<< Error: " errmsg " >>\n"))
		)
	(setvar 'cmdecho var_cmdecho)
	(setvar 'osmode var_osmode)
	)

(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

(setq var_cmdecho (getvar "cmdecho"))
(setq var_osmode (getvar "osmode"))
(setvar 'cmdecho 0)
(setvar 'osmode 0)

(setq ss1 (ssget '((0 . "MULTILEADER"))))

(setq sel (ssadd))
(setq sel_mls_not_compat (ssadd))
(setq cnt 0)

(repeat (setq cnt (sslength ss1))

	(setq cnt (1- cnt))

	(setq
		en (_dxf -1 (entget (ssname ss1 cnt)))
		endata (entget en)
		obj (vlax-ename->vla-object en)
		getLay (vla-get-Layer obj)
		getStyle (vla-get-StyleName obj)
		getTxtWidth (vla-get-TextWidth obj)
		getTxtStr (vla-get-TextString obj)
		getTxtRot (vla-get-TextRotation obj)
		lstpts (vl-remove-if-not
			'(lambda (p) (eq (car p) 10))
			(reverse endata)
			)
		lstptslen (length lstpts)
		ldxf10_1 (cdr (nth 1 (reverse lstpts)))
		ldxf10_2 (cdr (nth 3 (reverse lstpts)))
		ldxf10_3 (cdr (nth 2 (reverse lstpts)))
		getLeaderCnt (vla-get-LeaderCount obj)) ;; setq

	(cond
		((or (> lstptslen 5) (< lstptslen 4))
			(ssadd en sel_mls_not_compat)
			)

		((or (= lstptslen 5) (= lstptslen 4))
			(progn
				(if (= lstptslen 5)
					(command "_.MLEADER" "_H" "_L" "_O" "_M" 3 "_X" "_non" (trans ldxf10_1 0 1) "_non" (trans ldxf10_2 0 1) "_non" (trans ldxf10_3 0 1) ""))
				(if (= lstptslen 4)
					(command "_.MLEADER" "_H" "_L" "_O" "_M" 2 "_X" "_non" (trans ldxf10_1 0 1) "_non" (trans ldxf10_3 0 1) ""))
				(setq
					entnew (entlast)
					objnew (vlax-ename->vla-object entnew))
				(if en (progn
					(vla-put-TextString objnew getTxtStr)
					(vla-put-StyleName objnew getStyle)
					(vla-put-TextRotation objnew getTxtRot)
					(vla-put-Layer objnew getLay)
					(if (/= getTxtWidth 0)
						(vla-put-TextWidth objnew getTxtWidth))
					(entdel en)
					(ssadd entnew sel)
					))
				)
			)
		)

) ;; repeat

(if (> (sslength sel) 0) (progn
	(princ (strcat "\n: ------------------------------\n\t\t<<< You've created "(itoa (sslength sel)) (if (> (sslength sel) 1) " new MULTILEADERS" " new MULTILEADER") ". A legend has been born >>>\n: ------------------------------\n"))
	(sssetfirst nil sel)
	))

(if (and sel (> (sslength sel_mls_not_compat) 0)) (progn
	(princ (strcat "\n: ------------------------------\n\t\t*** Program found "(itoa (sslength sel_mls_not_compat)) (if (> (sslength sel_mls_not_compat) 1) " MULTILEADERS that are" " MLEADER that is") " not compatible ***\n: ------------------------------\n"))
	(princ (strcat "\n: ------------------------------\n\t\t*** NOTE: "(itoa (sslength sel)) (if (> (sslength sel) 1) " successfully converted MULTILEADERS have been" " successfully converted MULTILEADER has been") " selected ***\n: ------------------------------\n"))
	))

(*error* nil) (princ)

)  ;; end MR defun

;; -----------------------------------------------------------------------
;; ----------------------=={ Functions START }==--------------------------

;;----------------------------------------------------------------------;;
;; _dxf
;; Get DXF values from DXF pairs
;; args		- dxfcode elist
;; Example	- (_dxf -1 (entget (ssname (ssget) 0)))
;; Returns	- <Entity name: xxxxxxxxxxx>

(defun _dxf (code elist)
	(cdr (assoc code elist))
	)

;; -----------------------------------------------------------------------
;; ---------------------=={ Functions END }==-- --------------------------

(princ (strcat "\n: ------------------------------\n\"3dwannab_MLEADER_Recreate.lsp\" loaded | Version " *MLEADER_Recreate-Ver* " by 3dwannab. Type \"MLEADER_Recreate\" OR \"MR\" to run.\n: ------------------------------\n")) (princ)

;; -----------------------------------------------------------------------
;; -------------------=={ MLEADER_Recreate END }==------------------------
;; EOL

Edited September 7, 2018 by 3dwannab

February 26, 2019

3dwannab, thanx for idea.

I "rewrote" your code, added some other people's code and got it). This is not the cleanest code, but it works (at least for me).
P.S. Do not shoot the pianist - he plays as best he can.

;; Recreate mleader

;;  TODO:
;; - work with mleaders on locked layer (yes/no)

(defun c:kaa-Recreate-Mleader-2D
(/
*error*
acDoc
old_osmode
layer
islock
ent
entdata
VertexCoord
DogCoord
TextCoord
Cluster
obj
objClusters
oldLayer
oldStyle
oldTxtBackFill
oldTxtDir
oldTxtJustify
oldTxtRot
oldTxtStr
oldTxtWidth
oldDoglegDir
oldDoglegLength
oldLeaderLineVert
oldClustersCnt
oldLeaderLineVertices
oldLeaderLineIndexes
lstptslen
newMld
i
il
kk
ss1
sel
cnt
oldCorX
newCorX
)

(vl-load-com)
  
(defun *error* (errmsg)
	(and errmsg
		(not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
		(princ (strcat "\n<< Error: " errmsg " >>\n"))
	)
	(setvar 'osmode old_osmode)
  	(vla-put-lock layer islock)
);; end of defun

(vla-startundomark
	(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
) ;_ end of vla-startundomark

(setq layer (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (getvar "clayer")))
(setq islock (vla-get-lock layer))
(if (eq islock :vlax-true) (vla-put-lock layer :vlax-false))
  
(setq old_osmode (getvar "osmode"))
(setvar 'osmode 0)
(setq ss1 (ssget ":L" '((0 . "MULTILEADER"))))
(setq sel (ssadd))
(setq cnt 0)

(repeat (setq cnt (sslength ss1))

	(setq cnt (1- cnt))
	(setq ent (cdr (assoc -1 (entget (ssname ss1 cnt)))))
  	(setq entdata (entget ent))
	(setq obj (vlax-ename->vla-object ent))
	(setq oldClustersCnt (vla-get-LeaderCount obj))
	(setq oldLayer (vla-get-Layer obj))
	(setq oldStyle (vla-get-StyleName obj))
	(setq oldTxtWidth (vla-get-TextWidth obj))
	(setq oldTxtStr (vla-get-TextString obj))
	(setq oldTxtRot (vla-get-TextRotation obj))
	(setq oldTxtDir (vla-get-TextDirection obj))
	(setq oldTxtBackFill (vla-get-TextBackgroundFill obj))
  	(setq oldTxtJustify (vla-get-textjustify obj))
  	(setq oldDoglegLength (vla-get-dogleglength obj))
	(setq i -1)

	(cond
		(
			(> oldClustersCnt 0)
		  	(progn
				(setq kk -1)
			  	(setq VertexCoord (MleaderCoordsGet ent))
				(setq DogCoord (cdr (assoc 10 (cdr (member '(302 . "LEADER{") entdata)))))
				(setq TextCoord (cdr (assoc 10 entdata)))
				(setq lstptslen (length VertexCoord))
			  	(setq objClusters (MleaderClustersGet ent)) 
				(setq Cluster (nth 0 objClusters))
				(setq oldLeaderLineVert (vla-getleaderlinevertices obj Cluster))
				(setq oldDoglegDir (vla-GetDoglegDirection obj Cluster))
				(setq newMld
					(vlax-invoke
						(vlax-get-property (LM:acdoc)
							(if (= 1 (getvar 'cvport))
								'paperspace
								'modelspace
							)
						)
						'addmleader
						(append (nth 0 VertexCoord) DogCoord)
						0
					)
				);; end of setq
				(foreach i objClusters
					(setq oldLeaderLineIndexes (vlax-safearray->list (vlax-variant-value (vla-getleaderlineindexes obj i))));; получаем индексы массива выносок кластера i
					(foreach  il oldLeaderLineIndexes
					  	(setq kk (+ 1 kk))
						(if (/= il (nth 0 (vlax-safearray->list (vlax-variant-value (vla-getleaderlineindexes obj Cluster)))))
							(progn
								(setq oldLeaderLineVertices (vla-getleaderlinevertices obj il));; получаем массив 3д-координат выноски il
							  	(vla-addleaderlineex newMld oldLeaderLineVertices)
							  	(vla-setleaderlinevertices newMld kk  oldLeaderLineVertices)
							);; end of progn
						);; end of if
					);; end of foreach
				);; end of foreach

			  	(vla-setdoglegdirection newMld 0 (vlax-variant-value oldDoglegDir))
				(vla-setleaderlinevertices newMld 0 (vlax-variant-value oldLeaderLineVert))

				(vla-put-textstring newMld oldTxtStr)
				(vla-put-StyleName newMld oldStyle)
				(vla-put-TextRotation newMld oldTxtRot)
				(vla-put-TextDirection newMld oldTxtDir)
			  	(vla-put-Textjustify newMld oldTxtJustify)
				(vla-put-TextBackgroundFill newMld oldTxtBackFill)
			  	(vla-put-Layer newMld oldLayer)
				(if (/= oldTxtWidth 0) (vla-put-TextWidth newMld oldTxtWidth))
			  	(RN_MatchAnntScale (vlax-vla-object->ename obj) (vlax-vla-object->ename newmld))
				(entdel ent)
			);; end of progn
		 )
		(
			(= oldClustersCnt 0)
		 	(progn
			  	(setq TextCoord (cdr (assoc 10 entdata)))
			  	(setq oldCorX (nth 0 TextCoord))
			  	(setq newCorX (+ oldCorX (* oldDoglegLength -1)))
			  	(setq TextCoord (list newCorX (nth 1 TextCoord) (nth 2 TextCoord)))
			  	(setq newMld
					(vlax-invoke
						(vlax-get-property (LM:acdoc)
							(if (= 1 (getvar 'cvport))
								'paperspace
								'modelspace
							)
						)
						'addmleader
						(append (list 0.0 0.0 0.0) TextCoord)
						0
					)
				)
			  	
			  	(vla-put-textstring newMld oldTxtStr)
				(vla-put-StyleName newMld oldStyle)
				(vla-put-TextRotation newMld oldTxtRot)
				(vla-put-TextDirection newMld oldTxtDir)
			  	(vla-put-Textjustify newMld oldTxtJustify)
				(vla-put-TextBackgroundFill newMld oldTxtBackFill)
				(vla-put-Layer newMld oldLayer)
				(if (/= oldTxtWidth 0) (vla-put-TextWidth newMld oldTxtWidth))
			  	(vla-removeleaderline newmld 0)
			  	(RN_MatchAnntScale (vlax-vla-object->ename obj) (vlax-vla-object->ename newmld))
				(entdel ent)
			);; end of progn
		)
	);; end of cond
);; end of repeat

(setvar 'osmode old_osmode)
(vla-put-lock layer islock)
  
(vla-endundomark acDoc) ; undomark bottom mark
(*error* nil) (princ)
  
);; end of defun

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

;;;https://www.theswamp.org/index.php?topic=48967.msg541497#msg541497
;;; Returns position of mleader's leaderline head vertices

(defun MleaderCoordsGet ( ename / elist return)
	(setq elist (entget ename))
	(while (setq elist (cdr (member '(304 . "LEADER_LINE{") elist)))
		(setq return (cons (cdr (assoc 10 elist)) return))
	)
	(reverse return)
)

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

;;; Returns list of mleader's cluster

(defun MleaderClustersGet ( ename / elist return)
	(setq elist (entget ename))
	(while (setq elist (cdr (member '(302 . "LEADER{") elist)))
		(setq return (cons (cdr (assoc 90 elist)) return))
	)
	(reverse return)
)

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object
 
(defun LM:acdoc nil
   (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (LM:acdoc)
)

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

;; http://forum.dwg.ru/showpost.php?p=1573413&postcount=47
;;_RN_MatchAnntScale - Копируем аннотативный масштаб (масштабы)
;;_с одного объекта на другой (другие). По сути это Match Properties,
;;_но только для аннотативных масштабов.
;;; Match Properties for annotative scales

(defun RN_MatchAnntScale ( sourceobj  destinationobj / sourceann sourceannlist pr gr cmd adoc scale)
	(vl-load-com)
	(vla-startundomark
		(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
	) ;_ end of vla-startundomark
	(sssetfirst nil nil)
	(if
		(and
			(setq sourceann sourceobj)
			(IsAnnotative sourceann)
			(setq sourceannlist (GetAnnoScales sourceann))
			(setq destinationobj (ssadd destinationobj))
		)
		(foreach scale sourceannlist
			(progn
				(setq cmd (getvar "CMDECHO"))
				(vl-cmdf "_-objectscale" destinationobj "" "_Add" scale "")
				(command)
			);; end of progn
		);; end foreach
	)
(vla-endundomark adoc) ; undomark bottom mark
(princ)
);defun

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

  (defun GetAnnoScales (e / dict lst rewind res)
;;; Argument: the ename of an annotative object.
;;; Returns the annotative scales associated with the 
;;; ename as a list of strings.
;;; Example: ("1:1" "1:16" "1:20" "1:30")
;;; Returns nil if the ename is not annotative. 
;;; Can be used to test whether ename is annotative or not.
;;; Works with annotative objects: text, mtext, leader, mleader, 
;;; dimension, block reference, tolerance and attribute.
;;; Based on code by Ian Bryant.


;;;Joe Burk
;;;http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/how-do-i-make-hatch-annotative-via-vlisp-almost-there/m-p/2080831    
;; Argument: an ename or vla-object.
;; Return T if object is annotative, otherwise nil.
;;;(defun IsAnnotative (e)
;;;(if (not (eq (type e) 'ENAME))
;;;(setq e (vlax-vla-object->ename e))
;;;)
;;;(if (assoc -3 (entget e '("AcadAnnotative"))) T)
;;;)

;;;(defun IsAnnotative (e)
;;;(and e
;;;(setq e (cdr (assoc 360 (entget e))))
;;;(setq e (dictsearch e "AcDbContextDataManager"))
;;;(setq e (dictsearch (cdr (assoc -1 e)) "ACDB_ANNOTATIONSCALES"))
;;;(assoc 350 e)
;;;)
;;;)
    (if
      (and
        e
        (setq dict (cdr (assoc 360 (entget e))))
        (setq lst (dictsearch dict "AcDbContextDataManager"))
        (setq lst
               (dictsearch (cdr (assoc -1 lst)) "ACDB_ANNOTATIONSCALES")
        ) ;_ end of setq
        (setq dict (cdr (assoc -1 lst)))
      ) ;_ end of and
       (progn
         (setq rewind t)
         (while (setq lst (dictnext dict rewind))
           (setq e      (cdr (assoc 340 lst))
                 res    (cons (cdr (assoc 300 (entget e))) res)
                 rewind nil
           ) ;_ end of setq
         ) ;_ end of while
       ) ;_ end of progn
    ) ;_ end of if
    (reverse res)
  ) ;_end

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

(defun IsAnnotative (e)
	(and e
		(setq e (cdr (assoc 360 (entget e))))
		(setq e (dictsearch e "AcDbContextDataManager"))
		(setq e (dictsearch (cdr (assoc -1 e)) "ACDB_ANNOTATIONSCALES"))
		(assoc 350 e)
	)
)

February 28, 2019

a little update

;; Recreate mleader

;;  TODO:
;; - work with mleaders on locked layer (yes/no)

(defun c:kaa-Recreate-Mleader-2D
(/
*error*
acDoc
old_osmode
layer
islock
ss1
sel
cnt
ent
entdata
obj
obj-Last-Leader-Line-Point  
obj-Content-Base-Position
obj-Clusters-Count
obj-Layer
obj-Style
obj-TxtStr
obj-TxtWidth
obj-TxtBackFill
obj-TxtDir
obj-TxtJustify
obj-TxtRot
obj-Dogleg-Length
obj-Clusters
obj-First-Cluster
obj-Dogleg-Dir
obj-First-Leader-Line-Index
obj-First-Leader-Line-Vertex
newMld
obj-Leader-Line-Indexes
obj-Leader-Line-Vertices
obj-All-Leader-Line-Vertices
il
obj-tmp-Coor-X
new-tmp-Coor-X
)

(vl-load-com)

(vla-startundomark
	(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
) ;_ end of vla-startundomark
  
(defun *error* (errmsg)
	(and errmsg
		(not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
		(princ (strcat "\n<< Error: " errmsg " >>\n"))
	)
	(setvar 'osmode old_osmode)
  	(vla-put-lock layer islock)
);; end of defun

(setq layer (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (getvar "clayer")))
(setq islock (vla-get-lock layer))
(if (eq islock :vlax-true) (vla-put-lock layer :vlax-false))
  
(setq old_osmode (getvar "osmode"))
(setvar "osmode" 0)
(setq ss1 (ssget ":L" '((0 . "MULTILEADER"))))
(setq sel (ssadd))
(setq cnt 0)

(repeat (setq cnt (sslength ss1))

	(setq cnt (1- cnt))
	(setq ent (cdr (assoc -1 (entget (ssname ss1 cnt)))))
  	(setq entdata (entget ent))
	(setq obj (vlax-ename->vla-object ent))
	(setq obj-Clusters-Count (vla-get-LeaderCount obj))
	(setq obj-Layer (vla-get-Layer obj))
	(setq obj-Style (vla-get-StyleName obj))
	(setq obj-TxtWidth (vla-get-TextWidth obj))
	(setq obj-TxtStr (vla-get-TextString obj))
	(setq obj-TxtRot (vla-get-TextRotation obj))
	(setq obj-TxtDir (vla-get-TextDirection obj))
	(setq obj-TxtBackFill (vla-get-TextBackgroundFill obj))
  	(setq obj-TxtJustify (vla-get-textjustify obj))
  	(setq obj-Dogleg-Length (vla-get-dogleglength obj))

	(cond
		(
			(> obj-Clusters-Count 0)
		  	(progn
				(setq obj-Last-Leader-Line-Point   (cdr (assoc 10 (cdr (member '(302 . "LEADER{") entdata)))))
				(setq obj-Content-Base-Position  (cdr (assoc 10 entdata)))
			  	(setq obj-Clusters (MleaderClustersGet ent)) ;; cluster's index list
				(setq obj-First-Cluster (nth 0 obj-Clusters))
			  	(setq obj-Dogleg-Dir (vla-GetDoglegDirection obj obj-First-Cluster))
			  	(setq obj-First-Leader-Line-Index (nth 0 (vl-sort (kaa-var-to-list (vla-getleaderlineindexes obj obj-First-Cluster)) '<)))
				(setq obj-First-Leader-Line-Vertex (vla-getleaderlinevertices obj obj-First-Leader-Line-Index));; all leader line vertices 
				(setq newMld
					(vlax-invoke
						(vlax-get-property (LM:acdoc)
							(if (= 1 (getvar 'cvport))
								'paperspace
								'modelspace
							)
						)
						'addmleader
						(kaa-var-to-list obj-First-Leader-Line-Vertex)
						0
					)
				);; end of setq
			  
			  	(vla-put-Layer newMld obj-Layer)
			  	(vla-put-textstring newMld obj-TxtStr)
			  	(vla-put-TextRotation newMld obj-TxtRot)
				(vla-put-TextDirection newMld obj-TxtDir)
			  	(vla-put-Textjustify newMld obj-TxtJustify)
			  	(if (/= obj-TxtWidth 0) (vla-put-TextWidth newMld obj-TxtWidth))
				(vla-put-TextBackgroundFill newMld obj-TxtBackFill)
			  
				(if (/= obj-First-Cluster 0) (setq obj-Clusters (vl-sort obj-Clusters '<)) (vla-removeleader newmld 0))
				
				(setq obj-All-Leader-Line-Vertices (list 'txt))
				
				(foreach i obj-Clusters
				  	(if (= obj-First-Cluster 0)
						(setq obj-Leader-Line-Indexes (kaa-var-to-list (vla-getleaderlineindexes obj i)))
						(setq obj-Leader-Line-Indexes (vl-sort (kaa-var-to-list (vla-getleaderlineindexes obj i)) '<))
					);; end of if
					(foreach  il obj-Leader-Line-Indexes
				  		(progn
							(setq obj-Leader-Line-Vertices (vla-getleaderlinevertices obj il))
							(if (not (member (kaa-var-to-list obj-Leader-Line-Vertices) obj-All-Leader-Line-Vertices))
								(progn 
									(setq obj-All-Leader-Line-Vertices (cons (kaa-var-to-list obj-Leader-Line-Vertices) obj-All-Leader-Line-Vertices))
									(vla-addleaderlineex newMld obj-Leader-Line-Vertices)
								);; end of progn
							);; end of if
						);; end of progn
					);; end of foreach
				);; end of foreach		  	
			  	
  			  	(vla-setdoglegdirection newMld (nth 0 (MleaderClustersGet (vlax-vla-object->ename newmld))) (vlax-variant-value obj-Dogleg-Dir))
				(vla-setleaderlinevertices newMld
			  				(nth 0 (kaa-var-to-list (vla-getleaderlineindexes newmld (nth 0 (MleaderClustersGet (vlax-vla-object->ename newmld))))))
			  				(vlax-variant-value obj-First-Leader-Line-Vertex))
			  	(if (/= obj-First-Cluster 0) (vla-removeleaderline newmld 0))
			  
			  	(vla-put-StyleName newMld obj-Style)
				(RN_MatchAnntScale (vlax-vla-object->ename obj) (vlax-vla-object->ename newmld))
				(entdel ent)
			);; end of progn
		 )
		(
			(= obj-Clusters-Count 0)
		 	(progn
			  	(setq obj-Content-Base-Position  (cdr (assoc 10 entdata)))
			  	(setq obj-tmp-Coor-X (nth 0 obj-Content-Base-Position ))
			  	(setq new-tmp-Coor-X (+ obj-tmp-Coor-X (* obj-Dogleg-Length -1)))
			  	(setq obj-Content-Base-Position  (list new-tmp-Coor-X (nth 1 obj-Content-Base-Position ) (nth 2 obj-Content-Base-Position )))
			  	(setq newMld
					(vlax-invoke
						(vlax-get-property (LM:acdoc)
							(if (= 1 (getvar 'cvport))
								'paperspace
								'modelspace
							)
						)
						'addmleader
						(append (list 0.0 0.0 0.0) obj-Content-Base-Position )
						0
					)
				)
			  	
			  	(vla-put-Layer newMld obj-Layer)
			  	(vla-put-textstring newMld obj-TxtStr)
			  	(if (/= obj-TxtWidth 0) (vla-put-TextWidth newMld obj-TxtWidth))
				(vla-put-TextRotation newMld obj-TxtRot)
				(vla-put-TextDirection newMld obj-TxtDir)
			  	(vla-put-Textjustify newMld obj-TxtJustify)
				(vla-put-TextBackgroundFill newMld obj-TxtBackFill)
			  	(vla-removeleaderline newmld 0)
			  	(vla-put-StyleName newMld obj-Style)
			  	(RN_MatchAnntScale (vlax-vla-object->ename obj) (vlax-vla-object->ename newmld))
				(entdel ent)
			);; end of progn
		)
	);; end of cond
);; end of repeat

(setvar "osmode" old_osmode)
(vla-put-lock layer islock)
  
(vla-endundomark acDoc) ; undomark bottom mark
(*error* nil) (princ)
  
);; end of defun

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх


;;;https://www.theswamp.org/index.php?topic=48967.msg541497#msg541497
;;; Returns list of mleader's cluster

(defun MleaderClustersGet ( ename / elist return)
	(setq elist (entget ename))
	(while (setq elist (cdr (member '(302 . "LEADER{") elist)))
		(setq return (cons (cdr (assoc 90 elist)) return))
	)
	(reverse return)
)

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object
 
(defun LM:acdoc nil
   (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (LM:acdoc)
)
;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

;; variant to list
 
(defun kaa-var-to-list (source)
   (vlax-safearray->list (vlax-variant-value source))
)

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

;; http://forum.dwg.ru/showpost.php?p=1573413&postcount=47
;;_RN_MatchAnntScale - Копируем аннотативный масштаб (масштабы)
;;_с одного объекта на другой (другие). По сути это Match Properties,
;;_но только для аннотативных масштабов.
;;; Match Properties for annotative scales

(defun RN_MatchAnntScale ( sourceobj  destinationobj / sourceann sourceannlist pr gr cmd adoc scale)
	(vl-load-com)
	(vla-startundomark
		(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
	) ;_ end of vla-startundomark
	(sssetfirst nil nil)
	(if
		(and
			(setq sourceann sourceobj)
			(IsAnnotative sourceann)
			(setq sourceannlist (GetAnnoScales sourceann))
			(setq destinationobj (ssadd destinationobj))
		)
		(foreach scale sourceannlist
			(progn
				(setq cmd (getvar "CMDECHO"))
				(vl-cmdf "_-objectscale" destinationobj "" "_Add" scale "")
				(command)
			);; end of progn
		);; end foreach
	)
(vla-endundomark adoc) ; undomark bottom mark
(princ)
);defun

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

  (defun GetAnnoScales (e / dict lst rewind res)
;;; Argument: the ename of an annotative object.
;;; Returns the annotative scales associated with the 
;;; ename as a list of strings.
;;; Example: ("1:1" "1:16" "1:20" "1:30")
;;; Returns nil if the ename is not annotative. 
;;; Can be used to test whether ename is annotative or not.
;;; Works with annotative objects: text, mtext, leader, mleader, 
;;; dimension, block reference, tolerance and attribute.
;;; Based on code by Ian Bryant.


;;;Joe Burk
;;;http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/how-do-i-make-hatch-annotative-via-vlisp-almost-there/m-p/2080831    
;; Argument: an ename or vla-object.
;; Return T if object is annotative, otherwise nil.
;;;(defun IsAnnotative (e)
;;;(if (not (eq (type e) 'ENAME))
;;;(setq e (vlax-vla-object->ename e))
;;;)
;;;(if (assoc -3 (entget e '("AcadAnnotative"))) T)
;;;)

;;;(defun IsAnnotative (e)
;;;(and e
;;;(setq e (cdr (assoc 360 (entget e))))
;;;(setq e (dictsearch e "AcDbContextDataManager"))
;;;(setq e (dictsearch (cdr (assoc -1 e)) "ACDB_ANNOTATIONSCALES"))
;;;(assoc 350 e)
;;;)
;;;)
    (if
      (and
        e
        (setq dict (cdr (assoc 360 (entget e))))
        (setq lst (dictsearch dict "AcDbContextDataManager"))
        (setq lst
               (dictsearch (cdr (assoc -1 lst)) "ACDB_ANNOTATIONSCALES")
        ) ;_ end of setq
        (setq dict (cdr (assoc -1 lst)))
      ) ;_ end of and
       (progn
         (setq rewind t)
         (while (setq lst (dictnext dict rewind))
           (setq e      (cdr (assoc 340 lst))
                 res    (cons (cdr (assoc 300 (entget e))) res)
                 rewind nil
           ) ;_ end of setq
         ) ;_ end of while
       ) ;_ end of progn
    ) ;_ end of if
    (reverse res)
  ) ;_end

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

(defun IsAnnotative (e)
	(and e
		(setq e (cdr (assoc 360 (entget e))))
		(setq e (dictsearch e "AcDbContextDataManager"))
		(setq e (dictsearch (cdr (assoc -1 e)) "ACDB_ANNOTATIONSCALES"))
		(assoc 350 e)
	)
)

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

(princ)
(princ "\n:: kaa-Recreate-Mleader-2D - ”Recreate selected mleaders ::")
(princ)

February 28, 2019

I can't change my previous reply, so:

need to change this code

(if (= obj-First-Cluster 0)
	(setq obj-Leader-Line-Indexes (kaa-var-to-list (vla-getleaderlineindexes obj i)))
	(setq obj-Leader-Line-Indexes (vl-sort (kaa-var-to-list (vla-getleaderlineindexes obj i)) '<))
);; end of if

on this

(setq obj-Leader-Line-Indexes (vl-sort (kaa-var-to-list (vla-getleaderlineindexes obj i)) '<))

February 28, 2019

tried and the text inside of the ML remain changed, justification, bold, color, height... all the properties of the ML are reset...(arrow, color, extension distance) but the text won't change

February 28, 2019

bixcad, if i need to reset text properties i'm using "StripMtext Version 5.0c". Therefore, I do not see the need to add these functions to this code.

February 28, 2019

6 hours ago, bixcad said:

tried and the text inside of the ML remain changed, justification, bold, color, height... all the properties of the ML are reset...(arrow, color, extension distance) but the text won't change

The code in my last reply should remove the formating. Else you can use Lee Macs code like suggested.

March 1, 2019

I found a small error in my code that I don’t know how to fix - he resets dogleg length to default.

If mleader has only 1 leader it's not problem - just add to the code "vla-put-doglegged" and "vla-put-dogleglength" and it works fine.

But if mleader has 2 leaders with different dogleg length "vla-put-dogleglength" set the leg lengths the same.

March 1, 2019

The whole I idea of this is to reset the mleaders to the current style stripping them of all overrides. I think you've missed the point here. By putting values to the mleaders you're effectively doing nothing.

March 1, 2019

yep. it looks like you are right. thanx

March 1, 2019

28 minutes ago, Alexandr Kacugu said:

yep. it looks like you are right. thanx

No problem. My original code does just this. Meaning changing the mleader by style will change any mleaders now. As they've been recreated with only the basic values. The rest are as per the dictionary of the mleaders style.

Edited March 1, 2019 by 3dwannab

August 27, 2024

Le 12/11/2012 à 21:19, BlackBox a dit :

Bienvenue chez CADTutor !

(vl-load-com)

(defun c:FOO (/ ss styleName)
 (if (and (setq ss (ssget "_x" '((0 . "MULTILEADER"))))
          (dictsearch
            (namedobjdict)
            "ACAD_MLEADERSTYLE"
            (setq styleName [color=red]"YourMLeaderStyleName"[/color])
          )
     )
   (progn
     (vlax-for x (setq ss
                        (vla-get-activeselectionset
                          (vla-get-activedocument (vlax-get-acad-object))
                        )
                 )
       (vla-put-stylename x styleName)
     )
     (vla-delete ss)
   )
   (cond (ss (prompt "\n** MLeader style name not found ** "))
         ((prompt "\n** No MLeaders selected ** "))
   )
 )
)

bonjour,Cela
ne fonctionne pas pour moi, j’ai autocad 2025, après le chargement la commande « foo » ne semble pas se charger
pouvez-vous m’aider ?
et si vous pouviez l’intégrer dans le lisp fourni qui rassemble un ensemble de paramètres ajustés avec un seul LISP, ce serait magique

reset0.lsp

Sign In

Set MLeader to Existing MLeader Style via LISP

Recommended Posts

parkerdepriest

BlackBox

parkerdepriest

BlackBox

Lee Mac

bixcad

bixcad

Roy_043

3dwannab

Alexandr Kacugu

Alexandr Kacugu

Alexandr Kacugu

bixcad

Alexandr Kacugu

3dwannab

Alexandr Kacugu

3dwannab

Alexandr Kacugu

3dwannab

DELLA MAGGIORA YANN

Join the conversation

Tutorials

Forums

Activity