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)
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")
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.
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.
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.")
Ktiger,
This is great lisp to have when converting .DWG from way back prior to Multi-leader existed.
Thank you for sharing!
Best Regards
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.
Can't find what you're looking for? Ask the community or share your knowledge.