gmmdinesh Posted September 21, 2018 Share Posted September 21, 2018 Hello Experts, I have been used a lisp to add Mleader object to text and Mtext. And i have found this lisp from this forum. This lisp will be added the Mleader wit text and Mtext, but it's changed the text height and style after adding Mleader as per Mleader style which we set. Instead of default style, i want to keep the text height and style as it is. For ex. If the text height is 3 and it is bold..after adding the Mleader it's changed the height as 2 and plain style. But i want it should keep with same height and style. Could you please anyone suggest me how to do this. This code i have used. ;; original code by VVA (defun make_mleader_style (mleaderstylename textcolor leadercolor / adoc mldrdict newldrstyle objcolor ) (vl-load-com) (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (setq mldrdict (vla-item (vla-get-dictionaries adoc) "ACAD_MLEADERSTYLE") ) ;_ end of setq (setq newldrstyle (vlax-invoke mldrdict 'addobject mleaderstylename "AcDbMLeaderStyle" ) ;_ end of vlax-invoke ) ;_ end of setq (setq objcolor (vla-getinterfaceobject (vlax-get-acad-object) (strcat "AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2) ) ;_ end of strcat ) ;_ end of vla-getinterfaceobject ) ;_ end of setq (vla-put-colorindex objcolor textcolor) (vla-put-textcolor newldrstyle objcolor) (vla-put-colorindex objcolor leadercolor) (vla-put-leaderlinecolor newldrstyle objcolor) (foreach item (list '("AlignSpace" 4) (list "ArrowSize" (fix (/ (vla-get-arrowsize (vla-item mldrdict "Mleader Triangle")) 1.5 ) ;_ end of / ) ;_ end of fix ) ;_ end of list '("BitFlags" 0) '("BlockConnectionType" 1) '("BlockRotation" 0.0) '("BlockScale" 1.0) '("BreakSize" 0.125) '("ContentType" 2) ;mtext '("Description" "My Style Description") '("DoglegLength" 1.25) '("DrawLeaderOrderType" 0) '("DrawMLeaderOrderType" 1) '("EnableBlockRotation" -1) '("EnableBlockScale" -1) '("EnableDogleg" -1) '("EnableFrameText" 0) '("EnableLanding" -1) '("FirstSegmentAngleConstraint" 0) (list "LandingGap" (vla-get-landinggap (vla-item mldrdict "Standard")) ) ;_ end of list '("LandingGap" 1) '("LeaderLineType" 1) '("LeaderLineTypeId" "ByLayer") '("LeaderLineTypeId" "ByLayer") '("LeaderLineWeight" 60) '("MaxLeaderSegmentsPoints" 2) '("ScaleFactor" 1.0) '("SecondSegmentAngleConstraint" 0) '("TextAlignmentType" 0) '("TextAngleType" 1) '("TextHeight" 2) '("TextLeftAttachmentType" 1) ;original 3 '("TextRightAttachmentType" 1);original 3 '("TextString" "Default\\PText") '("TextStyle" "STANDARD") ) ;_ end of list (vlax-put newldrstyle (car item) (cadr item)) ) ;_ end of foreach newldrstyle ) ;_ end of defun ;; Test (defun c:admld (/ *error* ms) (vl-load-com) (while (defun *error* (msg) (command "_undo" "_e") (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) ) ;_ end of and (princ (strcat "\nError: " msg)) ) ;_ end of if (princ) ) ;_ end of defun (command "_undo" "_be") (if (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (setq ms (make_mleader_style "My style" 256 256));change "My style" and colors to suit ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of vl-catch-all-error-p (alert "Problem creating Mleader Style") (setvar "CMLEADERSTYLE" "My style");change "My style" to suit ) ;_ end of if (if (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (vla-put-arrowsymbol ms "_Origin2"));; existing arrow block in the drawing ) ;_ end of vl-catch-all-apply ) ;_ end of vl-catch-all-error-p (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (vla-put-arrowsymbol ms acarrowdefault)) ) ;_ end of vl-catch-all-apply ) ;_ end of vl-catch-all-error-p ) ;_ end of not ) ;_ end of if (princ) (vl-load-com) (cond ;;Select the text/mtext objects ((or (null (setq ss1 (ssget ":S" '((0 . "text,mtext"))))) (= 0 (setq ssl (sslength ss1))) ) nil ;nothing selected ) (T (setq Textobj (vlax-ename->vla-object (ssname ss1 0)) ActSpace (if (= 0 (getvar "cvport")) (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)) ) (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)) ) ) StartPt (getpoint "\nPick location for point of arrow head: ") txt (vla-get-TextString Textobj) TextPt (vla-get-insertionpoint textobj) TextPt (vlax-variant-value TextPt) TextPt (vlax-safearray->list TextPt) ptlist (vlax-make-safearray vlax-vbdouble '(0 . 5) ) ptlist (vlax-safearray-fill ptlist (append StartPt TextPt)) MLObj (vla-addmleader ActSpace ptlist 'LeaderIndex ) ) (vla-put-textstring mlobj txt) (vla-delete Textobj) ) ) ) ) ;_ end of defun Thanks in advance. Quote Link to comment Share on other sites More sharing options...
gmmdinesh Posted September 21, 2018 Author Share Posted September 21, 2018 Hi everyone. Could you please anyone help me on this? Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 22, 2018 Share Posted September 22, 2018 Hi, Set your desired Mleader Style current before you run the following codes because the program does not add any Mleader style. (defun c:2mld (/ sel get pt1 pt2 pts mld) ;;----------------------------------------------------;; ;; Author : Tharwat Al Shoufi. ;; ;; Date: 22.Sep.2018. ;; ;; Select text to add to Current Mleader style. ;; ;;----------------------------------------------------;; (princ "\nSelect text to add to new Mleader :") (if (and (or (setq sel (ssget "_+.:S:E:L" '((0 . "TEXT,MTEXT")))) (alert "Missed or Invalid object. Try again.") ) (setq pt1 (getpoint "\nSpecify 1st point :")) (setq pt2 (getpoint "\n2nd point :" pt1)) (setq pts (append (trans pt1 1 0) (trans pt2 1 0))) ) (progn (vla-put-textstring (setq mld (vlax-invoke (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)) ) ) 'addmleader pts 0 ) ) (cdr (assoc 1 (setq get (entget (ssname sel 0))))) ) (if (>= (car pt1) (car pt2)) (progn (vla-setdoglegdirection mld 0 (vlax-3D-point '(-1.0 0.0 0.0)) ) (vla-put-textjustify mld acattachmentpointmiddleright) (vlax-invoke mld 'setleaderlinevertices 0 pts) ) ) (vla-put-TextStyleName mld (cdr (assoc 7 get))) (vla-put-textheight mld (cdr (assoc 40 get))) (entdel (cdr (assoc -1 get))) ) ) (princ) ) (vl-load-com) Quote Link to comment Share on other sites More sharing options...
gmmdinesh Posted September 24, 2018 Author Share Posted September 24, 2018 Hello Tharwat, Thank you so much for your code.. It's working as i want. Thanks again. Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 24, 2018 Share Posted September 24, 2018 51 minutes ago, gmmdinesh said: Hello Tharwat, Thank you so much for your code.. It's working as i want. Thanks again. You're welcome anytime. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.