Multileader Text Color

Anonymous · ‎10-01-2017

Can anyone get me a lisp to change the color of the first line only of multileader text ?

pbejse · ‎10-01-2017

@Anonymous wrote:

Can anyone get me a lisp to change the color of the first line only of multileader text ?

That would be easy IF the new line is an actual return code. "The quick brown\\Pfox jumps over the lazy dog" Post a sample drawing Sherif.Magdy.

DannyNL · ‎10-02-2017

Try this.

Can probably be coded a bit more easy and more optimized but it gets the job done.

And only basic MTexts and coloring supported at the moment.

(defun c:Test (/ T_Selection T_NewColor T_Entity T_NewText T_OldText T_Object T_LineBreak T_CurrentColor)
   (if
      (and
         (setq T_Selection (ssget '((0 . "MTEXT"))))
         (setq T_NewColor (acad_colordlg 1 nil))
      )
      (progn
         (setq T_NewColor (strcat "\\C" (itoa T_NewColor)))
         (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
         (foreach T_Entity (vl-remove-if '(lambda (T_Item) (listp (cadr T_Item))) (ssnamex T_Selection))
            (setq T_NewText nil)
            (setq T_OldText (vla-get-TextString (setq T_Object (vlax-ename->vla-object (cadr T_Entity)))))
            (cond
               (
                  (or
                     (and
                        (setq T_LineBreak (vl-string-search "\\P" T_OldText))
                        (setq T_CurrentColor (RegEX "\\\\C\\d+" (substr T_OldText 1 T_LineBreak)))
                     )
                     (setq T_CurrentColor (RegEX "\\\\C\\d+" T_OldText))
                  )
                  (progn
                     (setq T_NewText (vl-string-subst T_NewColor T_CurrentColor T_OldText))
                  )
               )
               (
                  (setq T_LineBreak (vl-string-search "\\P" T_OldText))
                  (progn
                     (setq T_NewText (vl-string-subst (strcat "{" T_NewColor ";" (substr T_OldText 1 T_LineBreak) "}") (substr T_OldText 1 T_LineBreak) T_OldText))
                  )
               )
               (
                  T
                  (setq T_NewText (strcat "{" T_NewColor ";" T_OldText "}"))
               )
            )                 
            (vla-put-TextString T_Object T_NewText)                  
         )
         (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      )
   )
   (princ)
)         
               
(defun RegEx (RE_Pattern RE_SearchString / RE_RegExObject RE_Result RE_Return)
   (if
      (and
         (= (type RE_SearchString) 'STR)
         (= (type RE_Pattern)      'STR)
      )
      (progn
         (setq RE_RegExObject (vlax-get-or-create-object "VBScript.RegExp"))
         (vlax-put-property RE_RegExObject 'Pattern RE_Pattern)
         (setq RE_Result (vl-catch-all-apply 'vlax-invoke-method (list RE_RegExObject 'Execute RE_SearchString)))
         (if
            (and
               (not (vl-catch-all-error-p RE_Result))
               (> (vla-get-Count RE_Result) 0)
            )      
            (setq RE_Return (vla-get-Value (vlax-get-property RE_Result 'Item 0)))      
         )
         (vlax-release-object RE_RegExObject)
      )
   )
   RE_Return
)

Anonymous · ‎10-02-2017

Thanks for your concern but this just changes MTEXT not Multileader Text

DannyNL · ‎10-02-2017

Oops....my bad!

Thought MText instead of Multileader. Luckily only one thing needs to be changed and that is MTEXT to MUTLILEADER in the SSGET

(defun c:Test (/ T_Selection T_NewColor T_Entity T_NewText T_OldText T_Object T_LineBreak T_CurrentColor)
   (if
      (and
         (setq T_Selection (ssget '((0 . "MULTILEADER"))))
         (setq T_NewColor (acad_colordlg 1 nil))
      )
      (progn
         (setq T_NewColor (strcat "\\C" (itoa T_NewColor)))
         (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
         (foreach T_Entity (vl-remove-if '(lambda (T_Item) (listp (cadr T_Item))) (ssnamex T_Selection))
            (setq T_NewText nil)
            (setq T_OldText (vla-get-TextString (setq T_Object (vlax-ename->vla-object (cadr T_Entity)))))
            (cond
               (
                  (or
                     (and
                        (setq T_LineBreak (vl-string-search "\\P" T_OldText))
                        (setq T_CurrentColor (RegEX "\\\\C\\d+" (substr T_OldText 1 T_LineBreak)))
                     )
                     (setq T_CurrentColor (RegEX "\\\\C\\d+" T_OldText))
                  )
                  (progn
                     (setq T_NewText (vl-string-subst T_NewColor T_CurrentColor T_OldText))
                  )
               )
               (
                  (setq T_LineBreak (vl-string-search "\\P" T_OldText))
                  (progn
                     (setq T_NewText (vl-string-subst (strcat "{" T_NewColor ";" (substr T_OldText 1 T_LineBreak) "}") (substr T_OldText 1 T_LineBreak) T_OldText))
                  )
               )
               (
                  T
                  (setq T_NewText (strcat "{" T_NewColor ";" T_OldText "}"))
               )
            )                 
            (vla-put-TextString T_Object T_NewText)                  
         )
         (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      )
   )
   (princ)
)         
               
(defun RegEx (RE_Pattern RE_SearchString / RE_RegExObject RE_Result RE_Return)
   (if
      (and
         (= (type RE_SearchString) 'STR)
         (= (type RE_Pattern)      'STR)
      )
      (progn
         (setq RE_RegExObject (vlax-get-or-create-object "VBScript.RegExp"))
         (vlax-put-property RE_RegExObject 'Pattern RE_Pattern)
         (setq RE_Result (vl-catch-all-apply 'vlax-invoke-method (list RE_RegExObject 'Execute RE_SearchString)))
         (if
            (and
               (not (vl-catch-all-error-p RE_Result))
               (> (vla-get-Count RE_Result) 0)
            )      
            (setq RE_Return (vla-get-Value (vlax-get-property RE_Result 'Item 0)))      
         )
         (vlax-release-object RE_RegExObject)
      )
   )
   RE_Return
)

dtiemeyer · ‎12-12-2018

@DannyNL

I'm wondering why 'ByLayer' cannot be chosen when this command is run. We receive drawings where we want to strip out color overrides from multileaders. Could you provide a tweak to this code to do what we need? Cheers!

My other CAD is a Cadillac and I like to Revit to the Max!

ВeekeeCZ · ‎12-13-2018

@dtiemeyer wrote:

@DannyNL

I'm wondering why 'ByLayer' cannot be chosen when this command is run. We receive drawings where we want to strip out color overrides from multileaders. Could you provide a tweak to this code to do what we need? Cheers!

Well, allowing that is quite easy:

(setq T_NewColor (acad_colordlg 1 T))

...I didn't dive into all the code, but it seems to be working well.

dtiemeyer · ‎12-13-2018

Thanks @ВeekeeCZ, that's a step in the right direction, but if there are multiple lines of mtext embedded in the multileader, it only sets the top line to 'ByLayer'. Is there a way to do all the text of a multileader? (and even the leader portion itself?) Basically we just want to blast the entire thing to 'ByLayer'...

My other CAD is a Cadillac and I like to Revit to the Max!

ВeekeeCZ · ‎12-13-2018

@dtiemeyer wrote:

Thanks @ВeekeeCZ, that's a step in the right direction, but if there are multiple lines of mtext embedded in the multileader, it only sets the top line to 'ByLayer'. Is there a way to do all the text of a multileader? (and even the leader portion itself?) Basically we just want to blast the entire thing to 'ByLayer'...

Ouu, I thought that the routine works for you. But whatever - don't think this is the right tool for you.

Use THIS routine to strip MTEXT from a color. Then autocad's SETBYLAYER for MLEADER entity.

dtiemeyer · ‎12-13-2018

wow, we actually use an older version of StripMtext, and it's great. Unfortunately this new v5.0c says multileaders are supported, but it is not removing the color from the text embedded within them. I've also posted a question to the author of that app, perhaps he will respond. I've also attached an example file representing the problem - the multileaders are on Layer 0 (which is set to color 7), but both the leader and embedded mtext have green overrides - running StripMtext on them removes neither the green override of the leader nor the green override of the text. 😞

My other CAD is a Cadillac and I like to Revit to the Max!

ВeekeeCZ · ‎12-13-2018

Hmm, that's not an issue of the STRIPMTEXT. That should be solvable by SETBYLAYER. Not sure why it isn't.

Anyway, this will fix that.

(defun c:MleaderColorByLayer ( / ss i)

  (if (setq ss (ssget "_:L" '((0 . "MULTILEADER"))))
    (repeat (setq i (sslength ss))
      (setpropertyvalue (ssname ss (setq i (1- i))) "TextColor" 0)
      (setpropertyvalue (ssname ss i) "LeaderLineColor" 0)))
  (princ)
)

dtiemeyer · ‎12-13-2018

That is awesome. Thank you!

My other CAD is a Cadillac and I like to Revit to the Max!

ant7lop · ‎10-25-2024

can you change the code to select multileader and change the left attachment to left or right? thank you

ant7lop · ‎10-25-2024

sorry! quick question can you kindly make this lisp to change the change the left attachment to left or right with a selecting the multileader? thank you

ant7lop · ‎10-26-2024

Thank you for this lisp, I made some changes and it works for what I need I just want to say thank you very much

here are the small changes. now I can select the Multileader and it change the location of the leader either on top or bottom. 🙂

(defun c:ard ( / ss i)

(if (setq ss (ssget "_:L" '((0 . "MULTILEADER"))))
(repeat (setq i (sslength ss))
(setpropertyvalue (ssname ss (setq i (1- i))) "TextRightAttachmentType" 3)
(setpropertyvalue (ssname ss i) "TextRightAttachmentType" 3)))
(princ)
)

Community

Multileader Text Color

Multileader Text Color

Multileader Text Color