Create multileader style with LISP

[bdsmls]

Is there a way to create a multileader style with LISP if it doesn't exist?

All I really want to specify is the text style, text angle, text color and text height, but knowing how to specify the other parameters is a plus

Thanks,

Larry

[rapidcad]

Larry, welcome to the forums!

IDK if they can be set up as completely as you want to, but quite a bit can be set up through the vlax functions. I just don't know if there's enough ability to save a fully defined MLEADERSTYLE.

However, for my own needs I did the poor man's version by just checking to see if the style was there and then if not, then I just insert it in a carrier drawing (my template works just fine for me.. 

See if this method might work for you - I got the style checker from a Jeff Mishler post long ago...

;FIRST FROM Jeff Mishler, SEARCH THE DICTIONARY TABLES FOR MULTILEADER STYLES AND LIST THEM
(defun mLeaderstyleExist (styl / dict result)
  (if (setq dict (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE"))
    (foreach x dict
      (if (and (= (car x) 3)
        (eq (strcase (cdr x)) (strcase styl))
   )
 (setq result t)
      )
    )
  )
  result
)

(if (and (mLeaderstyleExist "TGW") (tblsearch "style" "TGW_1"))
    (progn;IF TGW_1 IS PRESENT, SET IT CURRENT
      (vl-cmdf "._cmleaderstyle" "TGW")
      (setvar "textstyle" "TGW_1")
      )
    (progn;IF TGW_1 ISN'T PRESENT, INSERT AND SET IT 
      (vl-cmdf "_.-insert" "TGWdwt.DWG" "0,0" "1" "1" "0")
      (vl-cmdf "._EXPLODE" "l")
      (vl-cmdf "._cmleaderstyle" "TGW")
      (setvar "textstyle" "TGW_1")
  )
)

Just try to modify the use of the function by replacing my example code with your carrier drawing and style name. IIRC, a lot of others have done it this way as well.

Hope this helps.

Ron 

[DannyNL]

You can also use the object model to add a MLeaderStyle through the ACAD_MLEADERSTYLE dictionary. This doesn't require the use of another drawing with the existing style although off course that is also a solution.

If the provided TextStyle doesn't exist or if the MLeader style already exists, this function will return an error message and terminate.

;;;
;;; Usage : (CreateMLeaderStyle [NewStyleName] [TextStyle] [TextAngle] [TextColor] [TextHeight])
;;; Examle: (CreateMLeaderStyle "Test"         "Standard"  1           6           2.5)
;;;
;;; [NewStyleName] - String  -> Name of new MLeader Style
;;; [TextStyle]    - String  -> Textstyle name to be used
;;; [TextAngle]    - Integer -> 0 - As Inserted / 1 - Keep Horizontal / 2- Always Right-Reading
;;; [TextColor]    - Integer -> AutoCAD Color Index number
;;; [TextHeight]   - Real    -> Height of text
;;;

(defun CreateMLeaderStyle (CMS_NewName CMS_Style CMS_Angle CMS_Color CMS_Height / CMS_MLeaderStyles CMS_NewMLeaderStyle CMS_ColorObject)
   (if
      (tblsearch "STYLE" CMS_Style)
      (progn
         (setq CMS_MLeaderStyles (vla-item (vla-get-Dictionaries (vla-get-ActiveDocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE"))
         (if
            (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list CMS_MLeaderStyles CMS_NewName)))
            (progn
               (setq CMS_NewMLeaderStyle (vla-AddObject CMS_MLeaderStyles CMS_NewName "AcDbMLeaderStyle"))
               (vla-put-TextStyle     CMS_NewMLeaderStyle CMS_Style)
               (vla-put-TextAngleType CMS_NewMLeaderStyle CMS_Angle)
               (setq CMS_ColorObject  (vla-get-TextColor CMS_NewMLeaderStyle))
               (vla-put-ColorIndex    CMS_ColorObject CMS_Color)
               (vla-put-TextColor     CMS_NewMLeaderStyle CMS_ColorObject)
               (vla-put-TextHeight    CMS_NewMLeaderStyle CMS_Height)
            )
             (princ "\n ** Error: MLeader style already exists")
         )
      )
      (princ "\n ** Error: textstyle does not exist")
   )
   (princ)
)

It would be easy to change other properties of the MLeader style as well by adding additional (vla-put-* CMS_NewMLeaderStyle [value]) statements with the property and desired value.

Properties for a MLeader style are:

AlignSpace
Annotative
ArrowSize
ArrowSymbol
BitFlags
Block
BlockColor
BlockConnectionType
BlockRotation
BlockScale
BreakSize
ContentType
Description
DoglegLength
DrawLeaderOrderType
DrawMLeaderOrderType
EnableBlockRotation
EnableBlockScale
EnableDogleg
EnableFrameText
EnableLanding
FirstSegmentAngleConstraint
LandingGap
LeaderLineColor
LeaderLinetype
LeaderLineTypeId
LeaderLineWeight
MaxLeaderSegmentsPoints
Name
ScaleFactor
SecondSegmentAngleConstraint
TextAlignmentType
TextAngleType
TextAttachmentDirection
TextBottomAttachmentType
TextColor
TextHeight
TextLeftAttachmentType
TextRightAttachmentType
TextString
TextStyle
TextTopAttachmentType

Though you should also know what type of value each one needs and accepts to be able to add them to the current code.

[rapidcad]

Now that's what I call a solution! Nicely done Danny! I'll have to try it!

[DannyNL]

Thanks!

Hope it helps 

[LISPlearner]

Good afternoon all, I found this code and I know this is what i need, but I am not seasoned enough with coding to fully understand, im afraid. I'll put the things I need to edit below. I just want a command I can type in that will create this style of mleader. I am not sure with the code posted above on where/how to place these specified properties. Here is what i got with the code. I will highlight what I added. Let me know if there is anything I can do to make this work, since this is exactly what I need to use. I got to this to create a command for the function, and utilizing the example at the top. This does not work at all. Any help would be appreciated!!

;;;
;;; Usage : (CreateMLeaderStyle [NewStyleName] [TextStyle] [TextColor] [TextHeight])
;;; Example: (CreateMLeaderStyle "Test"         "Standard"  6           2.5)
;;;
;;; [NewStyleName] - String  -> Name of new MLeader Style
;;; [TextStyle]    - String  -> Textstyle name to be used
;;; [TextAngle]    - Integer -> 0 - As Inserted / 1 - Keep Horizontal / 2- Always Right-Reading
;;; [TextColor]    - Integer -> AutoCAD Color Index number
;;; [TextHeight]   - Real    -> Height of text
;;;

(defun CreateMLeaderStyle (CMS_NewName CMS_Style CMS_Color CMS_Height / CMS_MLeaderStyles CMS_NewMLeaderStyle CMS_ColorObject)
   (if
      (tblsearch "STYLE" CMS_Style)
      (progn
         (setq CMS_MLeaderStyles (vla-item (vla-get-Dictionaries (vla-get-ActiveDocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE"))
         (if
            (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list CMS_MLeaderStyles CMS_NewName)))
            (progn
               (setq CMS_NewMLeaderStyle (vla-AddObject CMS_MLeaderStyles CMS_NewName "AcDbMLeaderStyle"))
               (vla-put-TextStyle     CMS_NewMLeaderStyle CMS_Style)
               (setq CMS_ColorObject  (vla-get-TextColor CMS_NewMLeaderStyle))
               (vla-put-ColorIndex    CMS_ColorObject CMS_Color)
               (vla-put-TextColor     CMS_NewMLeaderStyle CMS_ColorObject)
               (vla-put-TextHeight    CMS_NewMLeaderStyle CMS_Height)
            )
             (princ "\n ** Error: MLeader style already exists")
         )
      )
      (princ "\n ** Error: textstyle does not exist")
   )
   (princ)
)


(defun c:CreateStyle
  
 (CreateMLeaderStyle "Test" "ROMANS" 7 0.0625)

(princ)
)

ArrowSize 1/16"

DoglegLength 1/16"

LandingGap 1/32"

LeaderLineColor White OR "7"

Name "NewMLeader"

ScaleFactor DimScale
(^^ is this in reference to the "Overall scale" property rather than the annotative scale property? I dont want them to be annotative, but rather change the overall scale to whatever the DimScale is set at)

TextColor White OR 7

TextHeight 1/16"

TextLeftAttachmentType Middle Of Top Line

TextRightAttachmentType  Middle Of Top Line

TextStyle ROMANS

[DannyNL]

Try this.

I've modified the code to process a list of settings to create the new MLeader style.

Definitely not fool proof and limited error trapping, but if supplied the right list with properties & values it should work.

I've included the command TEST and this will create the MLeader style as specified in your post.

;;;
;;; Usage  : (CreateMLeaderStyle [NewStyleName] [ConfigList])
;;; Example: (CreateMLeaderStyle "Test"         '(("TextStyle" . "Standard")("TextHeight" . 2.5)))
;;;
;;; [NewStyleName] - String  -> Name of new MLeader Style
;;; [ConfigList]   - List    -> List with properties & values
;;;

(defun CreateMLeaderStyle (CMS_NewName CMS_Config / CMS_TextStyle CMS_MLeaderStyles CMS_NewMLeaderStyle CMS_Property CMS_ColorObject)   
   (if
      (or
         (and
            (setq CMS_TextStyle (cdr (assoc "TextStyle" CMS_Config)))
            (tblsearch "STYLE" CMS_TextStyle)
         )
         (not (cdr (assoc "TextStyle" CMS_Config)))
      )
      (progn
         (setq CMS_MLeaderStyles (vla-item (vla-get-Dictionaries (vla-get-ActiveDocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE"))
         (if
            (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list CMS_MLeaderStyles CMS_NewName)))
            (progn
               (setq CMS_NewMLeaderStyle (vla-AddObject CMS_MLeaderStyles CMS_NewName "AcDbMLeaderStyle"))
               (if
                  (not (cdr (assoc "TextStyle" CMS_Config)))
                  (vla-put-TextStyle CMS_NewMLeaderStyle (getvar "TEXTSTYLE"))
               )
               (foreach CMS_Item CMS_Config
                  (if
                     (and
                        (vl-consp CMS_Item)
                        (= (type (setq CMS_Property (car CMS_Item))) 'STR)
                        (not (listp (cdr CMS_Item)))
                        (vlax-property-available-p CMS_NewMLeaderStyle CMS_Property)
                     )
                     (cond
                        (
                           (wcmatch (strcase CMS_Property) "*COLOR*")
                           (setq CMS_ColorObject  (vlax-get-property CMS_NewMLeaderStyle CMS_Property))
                           (vla-put-ColorIndex CMS_ColorObject (cdr CMS_Item))
                           (vl-catch-all-apply 'vlax-put-property (list CMS_NewMLeaderStyle CMS_Property CMS_ColorObject))
                        )
                        (
                           T
                           (vl-catch-all-apply 'vlax-put-property (list CMS_NewMLeaderStyle CMS_Property (cdr CMS_Item)))
                        )
                     )
                  )
               )
               (princ (strcat "\n ** Created " CMS_NewName " MLeader style"))
            )
             (princ "\n ** Error: MLeader style already exists")
         )
      )
      (princ "\n ** Error: textstyle does not exist")
   )
   (princ)
)

(defun c:Test ()
   (CreateMLeaderStyle "NewMLeader"
      (list 
         '("ArrowSize"               . 0.0625)
         '("DoglegLength"            . 0.0625)
         '("LandingGap"              . 0.03125)
         '("LeaderLineColor"         . 7)
         (cons "ScaleFactor"         (getvar "DIMSCALE"))
         '("TextColor"               . 7)
         '("TextHeight"              . 0.0625)
         '("TextLeftAttachmentType"  . 1)
         '("TextRightAttachmentType" . 1)
         '("TextStyle"               . "ROMANS")
      )
   )
   (princ)
)

[LISPlearner]

This is PERFECT! Thank you so much! I look forward to really checking out this code to learn something from it! Also, just out of curiosity, if i named the style "Standard" would it overwrite the existing style? 

Thanks again, I've been looking all over for code that will do what i'm looking for to no avail. I really appreciate you helping me out!

[DannyNL]

No problem & glad I could help 

To answer your question; no, the routine doesn't overwrite existing styles but in that case will exit with a message the style already exists, so currently it can only create new styles.

[LISPlearner]

That's perfectly fine! does exactly what i need regardless. Thanks again for the help!!

[bdsmls]

Very nice!

What value would I specify to have the "LeaderLineColor" be "ByBlock"?

Larry

[DannyNL]

Hi Larry,

Color 0 would be the number for ByBlock.

[Anonymous]

Hi Danny! Thank you for this answer! I am very new to this and learned a lot from just looking at your lisp.

I am trying to adapt the code a little to accept user input for certain properties of the created multileader style.

Below is a very simple example of asking the user for the font and scale. Then attempting to use that in the list that your code has. Is it not possible to use local variables in the list?

Any help would be very appreciated! 🙂 

Thank you!

(setq font (getkword "\n? [Arial/Simplex]: "))

(setq scale (getkword "\nscale?: "))

(CreateMLeaderStyle "new"
(list
'("ArrowSize" . 0.1000)
'("DoglegLength" . 0.0500)
'("LandingGap" . 0.0500)
'("LeaderLineColor" . 256)
'("ScaleFactor"  scale)
'("TextColor" . 256)
'("TextHeight" . 0.1)
'("TextLeftAttachmentType" . 1)
'("TextRightAttachmentType" . 1)

'("TextStyle" font)

[Anonymous]

Actually, I figured out a way to make it work how I'd like by using a previous code you posted in this thread that did not rely on the list input.

It might be clumsy and bloated. Any pointers and improvements are appreciated! 🙂

Specifically, I am wondering about having multiple true or false action in if statements. I could not get that to work, so maybe that isn't possible? If it is possible, then some of the if statements in the lisp could be combined (set variable and create text style at once), correct?

(defun c:importMLeaders ()

(defun CreateMLeaderStyle (CMS_NewName CMS_Style CMS_Color CMS_Height CMS_Scale CMS_DLL CMS_Arrowsize CMS_Gap CMS_LAttach CMS_RAttach / CMS_MLeaderStyles CMS_NewMLeaderStyle CMS_ColorObject)
   (if
      (tblsearch "STYLE" CMS_Style)
      (progn
         (setq CMS_MLeaderStyles (vla-item (vla-get-Dictionaries (vla-get-ActiveDocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE"))
            (progn
               (setq CMS_NewMLeaderStyle (vla-AddObject CMS_MLeaderStyles CMS_NewName "AcDbMLeaderStyle"))
               (vla-put-TextStyle     CMS_NewMLeaderStyle CMS_Style)
               (setq CMS_ColorObject  (vla-get-TextColor CMS_NewMLeaderStyle))
               (vla-put-ColorIndex    CMS_ColorObject CMS_Color)
               (vla-put-TextColor     CMS_NewMLeaderStyle CMS_ColorObject)
               (vla-put-TextHeight    CMS_NewMLeaderStyle CMS_Height)
               (vla-put-ScaleFactor    CMS_NewMLeaderStyle CMS_Scale)
               (vla-put-DogLegLength    CMS_NewMLeaderStyle CMS_DLL)
               (vla-put-ArrowSize    CMS_NewMLeaderStyle CMS_Arrowsize) 
               (vla-put-LandingGap    CMS_NewMLeaderStyle CMS_Gap)           
               (vla-put-TextLeftAttachmentType    CMS_NewMLeaderStyle CMS_LAttach)
               (vla-put-TextRightAttachmentType    CMS_NewMLeaderStyle CMS_RAttach)            
            )         
      )
      (princ "\n ** Error: textstyle does not exist")
   )
   (princ)
)

(initget 1 "ARIAL SIMPLEX")
(setq font (getkword "\nFont? [Arial/Simplex]: "))

(initget 1 "Y N")
(setq ital (getkword "\nItalic? [Y/N]: "))

(if
  (= font "ARIAL")
    (if
      (= ital "N")
        (command ".-style" "ARIAL" "ARIAL" "0" "1" "0" "N" "N")
        (command ".-style" "ARIAL-ITAL" "ARIAL" "0" "1" "20" "N" "N")
    )
  (if
    (= ital "N")
      (command ".-style" "SIMPLEX" "SIMPLEX" "0" "1" "0" "N" "N" "N")
      (command ".-style" "SIMPLEX-ITAL" "SIMPLEX" "0" "1" "20" "N" "N" "N")
  )
)

(if
  (= font "ARIAL")
    (if
      (= ital "N")
        (setq font2 "ARIAL")
        (setq font2 "ARIAL-ITAL")
    )
  (if
    (= ital "N")
      (setq font2 "SIMPLEX")
      (setq font2 "SIMPLEX-ITAL")
  )
)

(if
  (= font "ARIAL")
    (if
      (= ital "N")
        (setq font3 "A")
        (setq font3 "AI")
    )
  (if
    (= ital "N")
      (setq font3 "S")
      (setq font3 "SI")
  )
)

(if
  (= ital "Y")
    (setq ital2 "Italicized")
    (setq ital2 "")
)

(initget 1 "Model Layout")
(setq where (getreal "Text in [Model/Layout]?: "))

(if
   (= "Model" where)
      (setq scale (getreal "Scale 1in = __ft? (example: 10, 20): "))
      (setq scale 1)
)

(setq scalename (rtos scale 2 0))

(setq name (strcat font3 "-" "0.080" "-" scalename "s"))
(CreateMLeaderStyle name font2 256 0.080 scale 0.05 0.080 0.05 1 1)

(setq name (strcat font3 "-" "0.100" "-" scalename "s"))
(CreateMLeaderStyle name font2 256 0.100 scale 0.05 0.100 0.05 1 1)

(setq name (strcat font3 "-" "0.120" "-" scalename "s"))
(CreateMLeaderStyle name font2 256 0.120 scale 0.05 0.120 0.05 1 1)

(setq name (strcat font3 "-" "0.125" "-" scalename "s"))
(CreateMLeaderStyle name font2 256 0.125 scale 0.05 0.125 0.05 1 1)

(setq name (strcat font3 "-" "0.160" "-" scalename "s"))
(CreateMLeaderStyle name font2 256 0.160 scale 0.05 0.160 0.05 1 1)

(setq name (strcat font3 "-" "0.200" "-" scalename "s"))
(CreateMLeaderStyle name font2 256 0.200 scale 0.05 0.200 0.05 1 1)

(setq name (strcat font3 "-" "0.240" "-" scalename "s"))
(CreateMLeaderStyle name font2 256 0.240 scale 0.05 0.240 0.05 1 1)

(setq name (strcat font3 "-" "0.360" "-" scalename "s"))
(CreateMLeaderStyle name font2 256 0.360 scale 0.05 0.360 0.05 1 1)

(setq name (strcat font3 "-" "0.480" "-" scalename "s"))
(CreateMLeaderStyle name font2 256 0.480 scale 0.05 0.480 0.05 1 1)

(setq name (strcat font3 "-" "0.720" "-" scalename "s"))
(CreateMLeaderStyle name font2 256 0.720 scale 0.05 0.720 0.05 1 1)

(alert (strcat ital2 " " font " multileader styles for " scalename " scale have been added."))

(princ)
)

[kylei7449]

How do you change a single property of the mleaderstyle? What I'm trying to do is modify existing mleaders to set the angle of the arrow to a specific degree. But I don't want to create a new style for it, I just want a macro that will allow me to change leaders on the fly. So for instance, I'm wanting to have multiple macros that have preset angles and I can simply click on the leaders I need to change. The property (I think) is 'FirstSegmentAngleConstraint'. Does anyone know or have a simple code snippet for something like this? If you click on the mleader and look at Properties there's nothing there for the angle of the arrow, so not sure how to access that? Thx

[dlanorh]

---

@kylei7449 wrote:

How do you change a single property of the mleaderstyle? What I'm trying to do is modify existing mleaders to set the angle of the arrow to a specific degree. But I don't want to create a new style for it, I just want a macro that will allow me to change leaders on the fly. So for instance, I'm wanting to have multiple macros that have preset angles and I can simply click on the leaders I need to change. The property (I think) is 'FirstSegmentAngleConstraint'. Does anyone know or have a simple code snippet for something like this? If you click on the mleader and look at Properties there's nothing there for the angle of the arrow, so not sure how to access that? Thx

---

That isn't possible with the FirstSegmentAngleConstraint Property since it pertains to a MLeader style and through that MLeaders with that style. It will therefore affect all MLeaders of a specific style, and cannot be changed on the fly for existing MLeaders. The property requires an long integer value, therefore it isn't possible to specify a specific "degree" angle :

The default setting for the FirstSegmentAngleConstraint is 0 (no constraint)

Setting this to 1 will constrain the first segment to intervals of 15 degrees

The settings are as follows:

1 = 15 degrees (available angles for first segment  0, 15, 30 , 45, 60.....................345)

2 = 30 degrees (available angles 0, 30 ,60.................................330)

3 = 45 degrees etc

.............

6 = 90 degrees

etc

All angles are measured from Autocad 0 angle (positive x axis)

[1mousho]

Great lisp

How can i turn off "EnableLanding"?

[ronjonp]

---

@1mousho wrote:

Great lisp

How can i turn off "EnableLanding"?

---

@1mousho 

Use this line '("EnableDogLeg" . 0) and comment out ("DoglegLength" . 0.0625).

[ibrahimpatel125]

Hello DannyNL,

Good Day. Hope you are doing well and thanks for sharing the above code.

I tried the same and it's found that; Multi Leaders with M.Text could be only created with it. I wanted to to create Multi Leaders with Block. Though I tried, I couldn't succeed. Could you please guide me. ?

I am attaching a snap of my requirement for your better understanding. Kindly check and provide a solution.

[pbejse]

With too many settings to check and verify, its  loads easier just to insert a block with the Multileader style already defined onto the drawing, but that's just me.