Lisp need modify to add mleader to text and Mtext

[gmmdinesh]

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.

[gmmdinesh]

Hi everyone.

Could you please anyone help me on this?

[Tharwat]

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)

 

[gmmdinesh]

Hello Tharwat,

Thank you so much for your code..

It's working as i want. Thanks again.

[Tharwat]

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.