LEADER to MLEADER Edit. UCS mode to do. Need some other help.

April 5, 2017

I've only been learning LISPing for a few weeks so C&C's are most welcome.

LINK TO VIDEO:

One of my most used LISPs is the LeaderToMleader.LSP. Found here.

It was last updated many moons ago, so I decided to try learn and modify it to suit. Many thanks to the original author Lyle Hardin.

I just need some guidance on how to get UCS working with it.

EDIT. Using the TRANS fn. It works okay. Took a bit of tweaking but I got it. Please test.

Here's a list of things I've changed at the top of the code:

Main ones are:

Multiple Selection - User can now select the LEADER and MTEXT together and no longer individually resulting in a much faster conversion.
Strip text - Of formatting option - LM:UnFormat fn written by LeeMac.
Annotation support - Program simply matches the (entget) object to that of the (entlast) object. With the help of AT:isAnnotative written by Alan J. Thompson.
Case conversion - Built in fns using (load "TcaseSup.lsp") - OPTIONS: Titlecase Lowercase Uppercase Sentencecase toGglecase Keepcase
Verts - Leader_To_Multileader now supports 2 or 3 points. (Old method was only 2). It uses the 1st, 2nd (if applicable) and last verts of the LEADER. The 4th vert or more, will get removed.
Text Rotation - MTEXT rotation is now preserved.
Undo levels - As opposed to one command at a time.

PS. How easy would it be to calculate the distance between the start point of the LEADER point and pos of the MTEXT and then for each of the closest pairs make them an MULTILEADER. That would be cool.


;;;	CADALYST 08/08 www.cadalyst.com/code
;		Tip 2305: Leader_To_Multileader.lsp LEADER to Multileader (c) 2008 Lyle Hardin
;		Pick an old style LEADER and text to create a new MLEADER entity and erase the old LEADER and text.
;		March/2008

;;;	EDITED ON 15/04/2017 BY 3DWANNAB
;		Reason for creating this, was to learn and create a LISP that I use on a regular basis.
;		Commandline Syntax: Type "Leader_To_Multileader" OR "LTM" to run Program.
;
;		ADDED	-	Case Conversion.
;						OPTIONS:
;						Titlecase Lowercase Uppercase Sentencecase toGglecase Keepcase.
;
;		ADDED	-	Annotation support. Program simply matches the (entget) object to that of the (entlast) object. With the help of AT:isAnnotative written by Alan J. Thompson.
;		ADDED	-	Custom LM:ssget fn written by LeeMac.
;		ADDED	-	Multiple Selection. User can now select the LEADER and MTEXT together and no longer individually resulting in a much faster conversion.
;		ADDED	-	Round off points - To nearest round number. That been 1. round fn written by Doug Broad. Additional credits to Joe Burke, Peter Toby.
;		ADDED	-	Strip MTEXT - Of formatting option - LM:UnFormat fn written by LeeMac.
;		ADDED	-	Text Rotation - MTEXT rotation is now preserved.
;		ADDED	-	Undo levels - As opposed to one command at a time.
;		ADDED	-	Picking of existing MLEADER to use as new style.
;						RMB-SPACEBAR-ENTER to skip this step and use the current MLEADER style
;						SETTINGS TRANSLATED IF PICKED:
;						(vla-put-Layer newmleader existingMlLayer)
;						(vla-put-ScaleFactor newmleader existingMlScale)
;						(vla-put-StyleName newmleader existingMlStyle)
;						(vla-put-TextWidth newmleader existingMlWidth)
;
;						SETTINGS TRANSLATED IF NOT:
;						(vla-put-Layer newmleader existingTxtLayer)
;						(vla-put-TextRotation newmleader existingTxtRot)
;						(vla-put-TextWidth newmleader existingTxtWidth)
;
;		CHG		-	Changed to 'vla-get-TextString' as more robust.
;		CHG		-	Moved new MLEADER to TEXT Layer as opposed to existing LEADER.
;		CHG		-	Picking never fails, prompts user to keep picking until successful. LM:SelectIf fn written by LeeMac.
;		FIX		-	ACADs built in functions to convert ill-formatted MTEXT creates a bug in the string result. LM:StringSubst by LeeMac.
;		FIX		-	End position of MLEADER.
;		FIX		-	Z coordinate to 0, resulting in no fuzzy text.
;		FIX		-	Forces the MLEADER to be created from the 'LEADER arrowHead first' resulting in correct results all the time.
;		FIX		-	Vertices, Leader_To_Multileader now supports 2 or 3 points.
;						If 2 (Straight) it straightens the MLEADER up to the Y axis of the LEADER point for those LEADERS at an angle.
;						If 3 (Dog Legged) it recreates those as they originally were.
;						If <3 (Multiple) it recreates the 1st, 2nd & end point point of the original LEADER. The 4th vert or more, will get removed.
;						NOTE: Not really any need for more than 3 points on an MLEADER, I don't think.
;
;;; KNOWN QUIRKS, BUGS
;		Works in different UCSs, if you are fixing MTEXT & LEADERS which are upside down then the new MLEADER might be a little wacky.
;
;;; FUTURE ADDITIONS
;		Convert based on how close the LEADER and MTEXT are away from each other. To enable multiple selection.
;
;;; COMMENT OUT
;		First off, Big THANKS to Lyle Hardin for the original code.
;		Big THANKS to LeeMac for the functions he has put up on his website.
;			Finally getting the basics of this LISP'ing lark thanks to guys like him.
;		Lots of other places on forums and Users too. To many users to mention.
;		Let me know your thoughts on this Program or if you want to drop a Thank you.
;			e. stephensherry147@yahoo.co.uk

(defun c:LTM nil (c:Leader_To_Multileader))
(defun c:Leader_To_Multileader ( /
*error*
cmde
entLeader
entLeaderName
entTxt
entTxtName
entTxtVlaObj
existingMlScale
existingMlStyle
existingMlvlaObj
existingMlWidth
existingTxtLayer
existingTxtRot
existingTxtString
existingTxtWidth
ldxf10_1
ldxf10_2
ldxf10_last
lstleaderlen
lstleaderpts
os
ss1
ss2
)

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

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

(setq cmde (getvar "cmdecho"))
(setq os (getvar "osmode"))
(setvar 'cmdecho 0)
(setvar 'osmode 0)

(if
(setq ss1
	(car
		(LM:SelectIf
			(strcat
				"\nSelect an existing MULTILEADER to use as the new style\nor RMB-SPACEBAR-ENTER to use current: '"
				(getvar "cmleaderstyle") "'."
				)
			(lambda ( x ) (eq "MULTILEADER" (cdr (assoc 0 (entget (car x)))))) entsel nil
			)
		)
	)
(progn
	(setq existingMlvlaObj (vlax-ename->vla-object ss1)
		existingMlLayer (vla-get-Layer existingMlvlaObj)
		existingMlStyle (vla-get-StyleName existingMlvlaObj)
		existingMlWidth (vla-get-TextWidth existingMlvlaObj)
		)
	(if	(/= T (AT:isAnnotative ss1))
		(setq existingMlScale (vla-get-ScaleFactor existingMlvlaObj))
		)
	(princ (strcat "\nStyle to use: ' " existingMlStyle " '"))
	)
)

(initget "Titlecase Lowercase Uppercase Sentencecase toGglecase Keepcase")
(setq ansCase
(cond
	(
		(getkword
			(strcat "\nChoose Text Case : [Title case/Lower case/Upper case/Sentence case/toGgle case/Keep case] <"
				(setq ansCase
					(cond ( ansCase ) ( "Keepcase" ))
					)
				">: "
				)
			)
		)
	( ansCase )
	)
)

(initget "Keepformatting Removeformatting")

(setq ansFromatting
(cond
	(
		(getkword
			(strcat "\nChoose Formatting : [Keep formatting/Remove formatting] <"
				(setq ansFromatting
					(cond ( ansFromatting ) ( "Keepformatting" ))
					)
				">: "
				)
			)
		)
	( ansFromatting )
	)
)

(while
(setq ss2
	(LM:ssget "\nSelect 1 LEADER & 1 MTEXT: "
		(list "_:L"
			(append '(
				(-4 . "<OR")
				(0 . "MTEXT")
				(0 . "LEADER")
				(-4 . "OR>")
				)
			)
			)
		)
	)

(if (/= (sslength ss2) 2)

	(progn
		(alert "Select only 1 MTEXT and 1 LEADER.")
		(princ "	>>> 'LTM' failed selection, try again ...")(princ)
		)

	(progn
		(if (= (cdr (assoc 0 (entget (ssname ss2 0)))) "LEADER")
			(setq
				entLeader (entget (ssname ss2 0))
				entTxt (entget (ssname ss2 1))
				)
			(setq
				entLeader (entget (ssname ss2 1))
				entTxt (entget (ssname ss2 0))
				)
			)

		(if
			(or (and (eq (dxf 0 entLeader) "LEADER") (eq (dxf 0 entTxt) "LEADER"))
				(and (eq (dxf 0 entLeader) "MTEXT") (eq (dxf 0 entTxt) "MTEXT")))

			(progn
				(alert "Please, check your Selection !\n\nSelect only 1 MTEXT and 1 LEADER.")
				(princ "	>>> 'LTM' failed selection, try again ...")(princ)
				)

			(progn

				(setq
					entLeaderName (dxf -1 entLeader)
					entTxtName (dxf -1 entTxt)
					existingTxtLayer (dxf 8 entTxt)

					entTxtVlaObj (vlax-ename->vla-object entTxtName)
					existingTxtString (vla-get-TextString entTxtVlaObj)

					existingTxtWidth (dxf 41 entTxt)
					existingTxtRot (dxf 50 entTxt)

					lstleaderpts (vl-remove-if-not
						'(lambda (p) (eq (car p) 10))
						entLeader
						)

					lstleaderlen (length lstleaderpts)

					ldxf10_1 (cdr (car lstleaderpts))

					ldxf10_1 (mapcar '(lambda (x)
						(round x 1)
						)

					ldxf10_1
					)

					ldxf10_2 (if (>= lstleaderlen 3)
						(cdr (nth (- lstleaderlen 2) lstleaderpts))
						)

					ldxf10_2 (mapcar '(lambda (x)
						(round x 1)
						)
					ldxf10_2
					)

					ldxf10_last (if (< lstleaderlen 3)
						(list (car (dxf 10 entTxt)) (cadr ldxf10_1) (caDDr (dxf 10 entTxt)))
						(list (car (dxf 10 entTxt)) (cadr ldxf10_2) (caDDr (dxf 10 entTxt)))
						; (list (car (dxf 10 entTxt)) (cadr ldxf10_1) 0)
						; (list (car (dxf 10 entTxt)) (cadr ldxf10_2) 0)
						)

					ldxf10_last (mapcar '(lambda (x)
						(round x 1)
						)
					ldxf10_last
					)

					)

				(cond
					((=  "Keepformatting" ansFromatting)
						)
					((= "Removeformatting" ansFromatting)
						(setq existingTxtString (LM:UnFormat existingTxtString nil))
						)
					)

				(progn

					(if (>= lstleaderlen 3)
						(progn
							(command "._MLEADER" "_L" "_H" "_O" "_M" 3 "_A" "_N" "_X" "_non" (trans ldxf10_1 0 1) "_non" (trans ldxf10_2 0 1) "_non" (trans ldxf10_last 0 1) "")
							)
						(progn
							(command "._MLEADER" "_L" "_H" "_O" "_M" 2 "_A" "_N" "_X" "_non" (trans ldxf10_1 0 1) "_non" (trans ldxf10_last 0 1) "")
							)
						)

					(setq newmleader (vlax-ename->vla-object (entlast)))

					(cond
						((=  "Titlecase" ansCase)
							(setq existingTxtString (acet-tcase-change-string existingTxtString "TITLE"))
							)
						((= "Lowercase" ansCase)
							(setq existingTxtString (acet-tcase-change-string existingTxtString "LOWER"))
							)
						((= "Uppercase" ansCase)
							(setq existingTxtString (acet-tcase-change-string existingTxtString "UPPER"))
							)
						((= "Sentencecase" ansCase)
							(setq existingTxtString (acet-tcase-change-string existingTxtString "SENTENCE"))
							)
						((= "toGglecase" ansCase)
							(setq existingTxtString (acet-tcase-change-string existingTxtString "TOGGLE"))
							)
						((= "Keepcase" ansCase)
							(setq existingTxtString existingTxtString)
							)
						)

					(setq existingTxtString (LM:StringSubst "\\\H" "\\\h" existingTxtString))
					(vla-put-TextString newmleader existingTxtString)
					(vla-put-TextRotation newmleader existingTxtRot)

					(if ss1

						(progn
							(command "._MATCHPROP" ss1 (entlast) "")
							(vla-put-TextWidth newmleader existingMlWidth)
							; (vla-put-StyleName newmleader existingMlStyle)
							; (vla-put-Layer newmleader existingMlLayer)
							(if	(/= T (AT:isAnnotative ss1))
								(vla-put-ScaleFactor newmleader existingMlScale)
								)
							)

						(progn

							(vla-put-Layer newmleader existingTxtLayer)

							(if (/= existingTxtWidth 0)
								(vla-put-TextWidth newmleader existingTxtWidth)
								)
							)

						)

					(command "_.erase" entTxtName "")
					(command "_.erase" entLeaderName "")

					(command "_.move" (entlast) "" '(0 0 1e99) ""
						"_.move" "_p" "" '(0 0 -1e99) "")

					(princ "	>>> 'LTM' has done the business ...")(princ)
					)
				)
			)
		)
)
)

(*error* nil)

(princ)

)

;; Unknown Autor

(defun dxf (code elist)
(cdr (assoc code elist))
)

;; Doug Broad
;; additional credits Joe Burke, Peter Toby

(defun round (value to)
(setq to (abs to))
(* to (fix (/ ((if (minusp value) - +) value (* to 0.5)) to)))
)

;;--------------------=={ String Subst }==--------------------;;
;;                                                            ;;
;;  Substitutes a string for all occurrences of another       ;;
;;  string within a string.                                   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  new - string to be substituted for 'old'                  ;;
;;  old - string to be replaced                               ;;
;;  str - the string to be searched                           ;;
;;------------------------------------------------------------;;
;;  Returns:  String with 'old' replaced with 'new'           ;;
;;------------------------------------------------------------;;

(defun LM:StringSubst ( new old str / inc len )
(setq len (strlen new)
	inc 0
	)
(while (setq inc (vl-string-search old str inc))
	(setq str (vl-string-subst new old str inc)
		inc (+ inc len)
		)
	)
str
)

;; ssget	-	Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;;
;; Arguments:
;; msg		-	selection prompt
;; params	-	list of ssget arguments

(defun LM:ssget ( msg params / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget params))
(setvar 'nomutt 0)
(if (and sel (not (vl-catch-all-error-p sel)))
	sel
	)
)

;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Provides continuous selection prompts until either a      ;;
;;  predicate function is validated or a keyword is supplied. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg  - prompt string                                      ;;
;;  pred - optional predicate function [selection list arg]   ;;
;;  func - selection function to invoke                       ;;
;;  keyw - optional initget argument list                     ;;
;;------------------------------------------------------------;;
;;  Returns:  Entity selection list, keyword, or nil          ;;
;;------------------------------------------------------------;;

(defun LM:SelectIf ( msg pred func keyw / sel ) (setq pred (eval pred))
(while
	(progn (setvar 'ERRNO 0) (if keyw (apply 'initget keyw)) (setq sel (func msg))
		(cond
			( (= 7 (getvar 'ERRNO))
				(princ "\nMissed, Try again.")
				)
			( (eq 'STR (type sel))
				nil
				)
			( (vl-consp sel)
				(if (and pred (not (pred sel)))
					(princ "\nInvalid Object Selected.")
					)
				)
			)
		)
	)
sel
)

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MTEXT formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MTEXT Flag (T if string is for use in MTEXT)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

(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
			)
		)
	)
)

;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/set-annotative-using-lisp-or-vlisp/m-p/3266716#M301077
;; Check if entity is annotative and which accounts for objects that were once annotative but are no longer.
;; ename - ename to check (returns T if annotative)
;; Alan J. Thompson

(defun AT:isAnnotative (ename / check)
(and (setq check (cdr (assoc 360 (entget ename))))
	(setq check (dictsearch check "AcDbContextDataManager"))
	(setq check (dictsearch (cdr (assoc -1 check)) "AcDb_AnnotationScales"))
	(assoc 350 check)
	)
)

;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/set-annotative-using-lisp-or-vlisp/m-p/3266684#M301075
;; By User pbejse
;; (IsAnno-p
;;   (setq itm (vlax-ename->vla-object (Car (entsel))))
;;   )

(defun IsAnno-p (ent / exd ano)
(vl-load-com)
(and (eq (vla-get-HasExtensionDictionary ent) :vlax-true)
	(setq exd (vla-GetExtensionDictionary ent)
		exd (vla-item exd "AcDbContextDataManager")
		ano (vla-item exd "ACDB_ANNOTATIONSCALES")
		)
	(not (zerop (vla-get-Count ano)))
	)
)

(load "TcaseSup.lsp")
(vl-load-com)

;; End

(princ
(strcat
	"\n:: Leader_To_Multileader.lsp edited on "
	(menucmd "m=$(edtime,0,DD-MO-yyyy)")
	" by 3dwannab (stephensherry147@yahoo.co.uk) loaded ::"
	"\n:: Type \"Leader_To_Multileader\" OR \"LTM\" to run Program ::"
	)
)
(princ)

MLEADER Test Drawing.dwg

Edited April 14, 2017 by 3dwannab
Updated Code with fixes

May 14, 2018

Would it be possible to comment out a section of this to remove vertices support? I get a weird result right now when I run this where I get extra vertices for no real reason, I think the leader I'm starting with have 3 points, (arrow, dogleg, end point), and your routine adds a new one. Any ideas?

May 15, 2018

Can you attach a problem LEADER and TEXT.

So you want more than 2 points of a LEADER to become 2 (start and end point). Is this correct?

May 15, 2018

Yes exactly, either as an option in the command, or if there is a way to comment out the section that adds the multi vertex support?

May 15, 2018

To only create MLEADERS with start and end point. Replace: (UNTESTED)

(if (>= lstleaderlen 2)
(progn
	(command "._MLEADER" "_L" "_H" "_O" "_M" 3 "_A" "_N" "_X" "_non" (trans ldxf10_1 0 1) "_non" (trans ldxf10_2 0 1) "_non" (trans ldxf10_last 0 1) "")
	)
(progn
	(command "._MLEADER" "_L" "_H" "_O" "_M" 2 "_A" "_N" "_X" "_non" (trans ldxf10_1 0 1) "_non" (trans ldxf10_last 0 1) "")
	)
)

With:

(command "._MLEADER" "_L" "_H" "_O" "_M" 2 "_A" "_N" "_X" "_non" (trans ldxf10_1 0 1) "_non" (trans ldxf10_last 0 1) "")

Sign In

LEADER to MLEADER Edit. UCS mode to do. Need some other help.

Recommended Posts

3dwannab

firegod819

3dwannab

firegod819

3dwannab

Join the conversation

Tutorials

Forums

Activity