Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Convert Quick Leader to Multileader?

16 REPLIES 16
Reply
Message 1 of 17
richdclemons
12676 Views, 16 Replies

Convert Quick Leader to Multileader?

Does anyone have a routine or know of one that will convert Quick Leaders to Multileaders?
16 REPLIES 16
Message 2 of 17
Ktiger12
in reply to: richdclemons

Here is a little lisp I created awhile back. Hope it work for you.

;LEADER2MULTILEADER
;Converts autocad leaders with text or mtext to autocad 2008+ multileaders
;created by Jeffery Allen - 11/1/2007

(defun C:LD2MLD (/ ent1 ent1-gcode ent1-type leader-pt-list leader-1st-pt leader-2nd-pt
ent2 ent2-gcode ent2-type text-strg)

(setq ent1(car(entsel "\nSelect a Leader: "))
ent1-gcode(entget ent1)
ent1-type(cdr(assoc 0 ent1-gcode))
)
(if(= ent1-type "LEADER")
(progn
(setq leader-pt-list(member(assoc 10 ent1-gcode) ent1-gcode)
leader-1st-pt(cdr(car leader-pt-list))
leader-2nd-pt(cdr(cadr leader-pt-list))
ent2(car(entsel "\nSelect Text or Mtext: "))
ent2-gcode(entget ent2)
ent2-type(cdr(assoc 0 ent2-gcode))
)
(if(or(= ent2-type "TEXT")(= ent2-type "MTEXT"))
(progn
(setq text-strg(cdr(assoc 1 ent2-gcode)))
(setvar "OSMODE" (boole 7 (getvar "OSMODE") 16384));osnap off
(setvar "CMDECHO" 0);command echo off
(command "_.ERASE" ent1 ent2 ""
"_.MLEADER" leader-1st-pt leader-2nd-pt text-strg
)
(setvar "CMDECHO" 1);command echo on
(setvar "OSMODE" (boole 2 (getvar "OSMODE") 16384));osnap on
)
)
(if(and(/= ent2-type "TEXT")(/= ent2-type "MTEXT"))(alert "Object selected is not a text or mtext"))
)
)
(if(/= ent1-type "LEADER")(alert "Object selected is not a leader"))
(princ)
);defun

(setq message "Leader 2 Multileader loaded...

Converts autocad leaders with text or
mtext to autocad 2008+ multileaders

Created by Jeffery Allen - 11/1/2007

Start command with \"LD2MLD\"")
(alert message)
(setq message nil)
(princ)

(c:LD2MLD)
Message 3 of 17
Ktiger12
in reply to: richdclemons

Here is a little lisp I created awhile back. Hope it work for you.

;LEADER2MULTILEADER
;Converts autocad leaders with text or mtext to autocad 2008+ multileaders
;created by Jeffery Allen - 11/1/2007

(defun C:LD2MLD (/ ent1 ent1-gcode ent1-type leader-pt-list leader-1st-pt leader-2nd-pt
ent2 ent2-gcode ent2-type text-strg)

(setq ent1(car(entsel "\nSelect a Leader: "))
ent1-gcode(entget ent1)
ent1-type(cdr(assoc 0 ent1-gcode))
)
(if(= ent1-type "LEADER")
(progn
(setq leader-pt-list(member(assoc 10 ent1-gcode) ent1-gcode)
leader-1st-pt(cdr(car leader-pt-list))
leader-2nd-pt(cdr(cadr leader-pt-list))
ent2(car(entsel "\nSelect Text or Mtext: "))
ent2-gcode(entget ent2)
ent2-type(cdr(assoc 0 ent2-gcode))
)
(if(or(= ent2-type "TEXT")(= ent2-type "MTEXT"))
(progn
(setq text-strg(cdr(assoc 1 ent2-gcode)))
(setvar "OSMODE" (boole 7 (getvar "OSMODE") 16384));osnap off
(setvar "CMDECHO" 0);command echo off
(command "_.ERASE" ent1 ent2 ""
"_.MLEADER" leader-1st-pt leader-2nd-pt text-strg
)
(setvar "CMDECHO" 1);command echo on
(setvar "OSMODE" (boole 2 (getvar "OSMODE") 16384));osnap on
)
)
(if(and(/= ent2-type "TEXT")(/= ent2-type "MTEXT"))(alert "Object selected is not a text or mtext"))
)
)
(if(/= ent1-type "LEADER")(alert "Object selected is not a leader"))
(princ)
);defun

(setq message "Leader 2 Multileader loaded...

Converts autocad leaders with text or
mtext to autocad 2008+ multileaders

Created by Jeffery Allen - 11/1/2007

Start command with \"LD2MLD\"")
(alert message)
(setq message nil)
(princ)

(c:LD2MLD)
Message 4 of 17
richdclemons
in reply to: richdclemons

Jeffery, you are a life saver my friend...this routine works like a charm!

Thanks!!
Message 5 of 17
Ktiger12
in reply to: richdclemons

your welcome
Message 6 of 17
FeeopEngr
in reply to: Ktiger12

I realize this is old, but I just found it and I love it. You saved me so much time.

 

Question, will this load everytime I open cad (2015)

Feeop
Message 7 of 17
RJanw01
in reply to: FeeopEngr

If you add it to your acad.lsp to load or in the startup suite it will load every time. Also make sure it is in the support file search path.

 

I have used similar lisps and made a small addition to it. If you notice it changes the qleader to the current mleader style. We have 6 different mleader styles we use so I added a setting of the mleader style and just modified the defun for which style I wanted. ex. 4" text = l2m4, 3" = l2m3, etc.

 

(defun c:L2M4 ()
(setvar "cmleaderstyle" "your Multileader style name here")

Message 8 of 17
msteen
in reply to: Ktiger12

Thank you for sharing this.  It has been very helpful!!

Message 9 of 17
aifos.bim
in reply to: Ktiger12

This lisp routine is amazing!!!

 

 

Is there a way to select more than one row of mtext to add to a leader?  If not it is fine.

Message 10 of 17
annw2
in reply to: Ktiger12

This is working pretty well, but seems to have a maximum number of characters.  It is cutting off some of the text.

 

Next I need to learn LISP and have it remove all formatting & change to ALL CAPS.

Ann Wingert, P.E.
Message 11 of 17
gccdaemon
in reply to: annw2

Can't remember where I got this, but for those of you who hate multileaders, here is one that works in reverse.

 

(defun C:MLDR2LDR (/ ss data leader-10-list start-pt last-pt second-pt
                     lyr curlyr curosmode ITEMS i EN)
  (setvar "cmdecho" 0)
  (setq curlyr (getvar "clayer"))
  (setq curosmode (getvar "osmode"))
  (command "UNDO" "mark") ;undo mark
  (setvar "osmode" 0)
  (setq ITEMS (ssget "X" '((0 . "MULTILEADER")))) ;select items
  (setq i (sslength ITEMS)) ;counter
  (while (> i 0) ;while items left
    (defun massoc	(key EntData / x nlist)
      (foreach x EntData
        (if (eq key (CAR x))
         (setq nlist (cons (cdr x) nlist))
        ) ;_ end of if 
      ) ;_ end of foreach 
      (reverse nlist)
    ) ;_ end of DEFUN
    (setq i (1- i)) ;decrement counter
    (setq EN (ssname ITEMS i)) ;get name
    (setq data (entget EN)) ;entity info
    (setq lyr (cdr (assoc 8 data)))
    (setq leader-10-list (massoc 10 data))
    (setq start-pt (nth 2 leader-10-list))
    (setq second-pt (nth 1 leader-10-list))
    (setq last-pt (nth 0 leader-10-list))
    (command "._explode" EN)
    (command "._erase" "L" "")
    (command "._erase" "L" "")
    (command "._erase" "L" "")
    (command "-layer" "Set" lyr "")
    (command "._leader" start-pt second-pt last-pt "" "" "None")
    (command "-layer" "Set" curlyr "")
  ); end while
  (princ "\nAll MultiLeaders have been replaced by Leaders.")
  (setvar "cmdecho" 1)
  (setvar "osmode" curosmode)
  (princ)
) ;_ end of defun

(prompt "\nType MLDR2LDR to run.")

 

Andrew Ingram
Civil 3D x64 2019
Win 10 x64 Pro
Intel Xeon E5-1620
32 GB Ram
Message 12 of 17
szhang
in reply to: Ktiger12

Ktiger,

 

This is great lisp to have when converting .DWG from way back prior to Multi-leader existed.

Thank you for sharing!

 

Best Regards

 

 

Message 13 of 17
chriswade
in reply to: szhang

Here is my version, it should work with individual lines, as well as quick leaders.

 

(defun c:l2m ( / *TEXTWIDTH* *thisdrawing* *modelspace* *paperspace* *IsCivil* *content* *textconvert* *BlockName* *TEXT* Obj TempText tPt1 SS SS_Text SS_Other ct Ent Ent_Name EntTemp LdrPts SelLen newpoints Pt1 Pt2 mlobj Obj LowerLeft UpperRight PtList TxtLen Att Temp Pt1Tst)

(vl-load-com)

;l2m-getpoints function originally written by:
;Copyright? 2009 Ron Perez (ronperez@gmail.com)
(defun l2m-getpoints (Obj)
	(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget obj)))
)
;The following code was modified from code by Lee Mac at http://www.theswamp.org/index.php?topic=35376.msg406150#msg406150
(defun GetAttData( blockObject / Obj)
  (setq blockObject (vlax-ename->vla-object blockObject))
  (mapcar
    (function
      (lambda ( attrib ) (cons (vla-get-Tagstring attrib) (vla-get-TextString attrib)))
    )
    (vlax-invoke blockObject 'GetAttributes)
  )
)

;End of Supporting Functions
	(setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)) ; Sets the drawing based variables
	      *modelspace*  (vla-get-ModelSpace *thisdrawing*)
		  *paperspace*  (vla-get-PaperSpace *thisdrawing*)
		  *path* (getvar "dwgprefix")
	)
  ;Begin of layer control - Change name "LEADER" to your standard layer
	(if (not (tblsearch "LAYER" "LEADER"))	; Check to see if layer exsists
		(progn
			(if (= 1 (getvar "pstylemode"))
				(progn
					(command "._-layer" "n" "LEADER" "color" "WHITE" "" "lweight" "DEFAULT" "" "ltype" "CONTINUOUS" "" "")
				)
				(progn
					(command "._-layer" "n" "LEADER" "color" "WHITE" "" "lweight" "DEFAULT" "" "ltype" "CONTINUOUS" "" "pstyle" "BLACK" "" "")
				)
			)
		)
	)
  ;End of Layer Control
	(If (> (strlen *path*) 5)
		(progn
			(setq pos (vl-string-position (ascii "\\") *Path* (+ (vl-string-position (ascii "\\") *path* 5) 1)))
			(If (or (= (strcase (substr *path* (+ pos 8) 1)) "C") (= (getvar "USERS5") "CIVIL"))
					(setq *IsCivil* T)
			)
		)
	)
	(while (= SS nil)
		(princ "\rSelect items to convert: ")
		(setq SS (ssget))
		(if (= SS nil)
			(princ "\nYou must select items to convert.")
		)
	)
	(setq SelLen (sslength SS))
	(setq CT 0)
	(while (< CT SelLen)
		(vl-cmdf "._join" (ssname SS CT) SS "")
		(ssadd (entlast) SS)
		(setq CT (+ CT 1))
	)
	(setq SS_Text (ssadd)
	      SS_Other (ssadd)
	      ct 0
	)
	(while (< ct (sslength SS))
		(setq Ent (ssname SS ct))
		(setq Ent_Name (cdr (assoc 0 (entget ent))))
		(if (and (/= Ent nil) (/= Ent_Name nil))
			(cond
				((wcmatch Ent_Name "*TEXT")
					(ssadd Ent SS_Text)
					(setq *content* "TEXT")
					(setq Obj (vlax-ename->vla-object Ent))
					(if (= (vla-get-objectname Obj) "AcDbText")
						(setq *textconvert* T)
					)					
				)
				((or (wcmatch Ent_Name "*BLOCK*") (wcmatch Ent_Name "INSERT"))
					(ssadd Ent SS_Text)
					(setq *content* "BLOCK")
				)
				((= Ent_Name "LINE")
					(vl-cmdf "._join" Ent SS "")
					(vl-cmdf "._pedit" "m" (entlast) SS "" "y" "j" "0" "")
					(ssadd (entlast) SS_Other)
					(ssadd (entlast) SS)
				)
				(T
					(ssadd Ent SS_Other)
				)
			)
		)
		(setq ct (+ ct 1))
	)
	(if (and (= *textconvert* T) (= *content* "TEXT"))
		(progn
			(t2mtUL SS_Text)
			(setq SS_Text nil
			      SS_Text (ssadd)
			)
			(ssadd (entlast) SS_Text)
		)
	)
	(setq ct 0)
	(while (< ct (sslength SS_Text))
		(setq Obj (vlax-ename->vla-object (ssname SS_Text ct)))
		(cond
			((= *content* "TEXT")
				(vla-getboundingbox obj 'LowerLeft 'UpperRight)
				(setq PtList (mapcar 'vlax-safearray->list (list LowerLeft UpperRight))
					  Temp (distance (car PtList) (list (caadr PtList) (cadar PtList)))
				)
				(if (= *TEXTWIDTH* nil)
					(setq *TEXTWIDTH* TEMP)
					(progn
						(If (>= Temp *TEXTWIDTH*)
							(setq *TEXTWIDTH* Temp)
						)
					)
				)
				(if (= *TEXT* nil)
					(setq *TEXT* (LM:GetTextString (ssname SS_Text ct)))
					(setq *TEXT* (strcat *TEXT* "\\P" (LM:GetTextString (ssname SS_Text ct))))
				)
			)
			((= *content* "BLOCK")
				(if (= *TEXT* nil)
					(progn
						(setq EntTemp (ssname SS_Text ct)
							  *TEXT* (getAttData EntTemp)
						)
						(IF (/= *TEXT* NIL)
						     (SETQ *BlockName* (cdr (assoc 2 (entget EntTemp))))
		 			     	 (setq Tpt1 (cdr (assoc 10 (entget EntTemp))))
						)
					)
				)
			)
		)
		(vla-delete Obj)
		(setq CT (+ CT 1))
	)
	(setq CT 0)
	(If (> (sslength SS_Other) 0)
		(progn
			(setq Obj (vlax-ename->vla-object (ssname SS_Other 0)))
			(setq LdrPts (l2m-getpoints (ssname SS_Other 0)))
			(vla-delete Obj)
		)
	)
	(cond
		((and LdrPts
			(setq Pt1 (car LdrPts)
			      Pt2 (cadr LdrPts)
			)
		 )
		)
		(T
			;Update to more robust code
			(setq Pt1 (getpoint "\nPlease select first point")
			      Pt2 (getpoint Pt1 "\nPlease select second point")
			)
		)
	)
	(setq Pt1Tst (osnap Pt1 "_NEA"))
	(If (= Pt1Tst nil)
		(SETVAR "CMLEADERSTYLE" "BEINOB-R1")
		(SETVAR "CMLEADERSTYLE" "BEIOB-R1")
	)
	(if (/= TPt1 nil)
		(progn
			(if (> (car Pt1) (car Pt2))
				(progn
					(if (> (car Tpt1) (car Pt1))
						(setq Pt1 Tpt1)
					)
				)
				(progn
					(if (< (car Tpt1) (car Pt1))
						(setq Pt1 Tpt1)
					)
				)
			)
		)
	)
	(setq newpoints (vlax-make-safearray vlax-vbDouble '(1 . 6)))
	(vlax-safearray-put-element newpoints 1 (car Pt1))
	(vlax-safearray-put-element newpoints 2 (cadr Pt1))
	(vlax-safearray-put-element newpoints 3 (caddr Pt1))
	(vlax-safearray-put-element newpoints 4 (car Pt2))
	(vlax-safearray-put-element newpoints 5 (cadr Pt2))
	(vlax-safearray-put-element newpoints 6 (caddr Pt2))
	(if (and (/= mlobj nil) (not (vlax-erased-p mlobj)))
		(vla-delete mlobj)
	)
	(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
		(setq mlobj (vla-AddMleader *modelspace* newpoints 0))
		(setq mlobj (vla-AddMleader *paperspace* newpoints 0))
	)
	(setq ax (vla-get-dogleglength mlobj))
	(if (> (car Pt1) (car Pt2))
		(progn
			(vla-put-dogleglength mlobj 0); This code is from http://www.theswamp.org/index.php?topic=31348.msg369336#msg369336
			; Code from: http://www.theswamp.org/index.php?topic=30817.0
			(vla-SetDogLegDirection mlobj 0 (vlax-3D-point (list (if (<= (car pt1) (car Pt2)) 1 -1) 0 0)))
			; End of code from: http://www.theswamp.org/index.php?topic=30817.0
			(vla-put-dogleglength mlobj ax); This code is from http://www.theswamp.org/index.php?topic=31348.msg369336#msg369336
		)
	)	
	(cond
		((= *content* "TEXT")
			(vla-put-TextString mlobj *TEXT*)
			(if (> (car pt1) (car Pt2))
				(vla-put-TextJustify mlobj acAttachmentPointTopRight)
			)
			(vla-put-textwidth mlobj *TEXTWIDTH*)
		)
		((AND (= *content* "BLOCK") (/= *BlockName* nil))
			(vla-put-ContentBlockName mlobj *BlockName*)
			(if (/= *TEXT* nil)
				(Progn
					(setq Ct 0
						  TxtLen (length *TEXT*)
					)
					(while (< CT TxtLen)
						(foreach Att *TEXT*
							(LM:SetMLeaderBlockAttributeValue mlobj (car Att) (cdr Att))
						)
						(setq Ct (+ Ct 1))						
					)
				)
			)
		)
	)
)

I believe that I have put credit where credit is due, if you see your code used and I have not provided credit, please let me know.

Message 14 of 17
bmichaels
in reply to: chriswade

This one didn't seem to work. But thanks anyways.

Message 15 of 17
pendean
in reply to: bmichaels

That LISP routine has been around for over a decade now, find one that works for you here https://www.google.com/search?q=autocad+leader+to+mleader+lisp

Message 16 of 17
shingda1
in reply to: Ktiger12

THANK YOU ,ITS VERY USEFUL

 

Message 17 of 17
shingda1
in reply to: Ktiger12

THANK YOU SO MUCH

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost