Mleader Styles and Settings - Update with LISP

[Anonymous]

I have this lisp routine that creates a mleader style but it doesn't change any of the settings such as text height, arrow sizes, etc. At the end of the lisp routine under "(list...", I thought these settings would update the mleader settings but it doesn't. Can anyone help? I'm not an expert in coding by any means.

Thanks

;;;
;;; 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"))
(setvar "CMLEADERSTYLE" "STANDARD")
            )
             (princ "\n ** Error: MLeader style already exists")
         )
      )
      (princ "\n ** Error: textstyle does not exist")
   )
   (princ)
)
(defun c:TEST ()
   (CreateMLeaderStyle "STANDARD"
      (list 
         '("ArrowSize"               . 0.08)
         '("DoglegLength"            . 0.035)
         '("LandingGap"              . 0.08)
         '("LeaderLineColor"         . 7)
         (cons "ScaleFactor"         (getvar "DIMSCALE"))
         '("TextColor"               . 7)
         '("TextHeight"              . 0.08)
         '("TextLeftAttachmentType"  . 1)
         '("TextRightAttachmentType" . 1)
         '("TextStyle"               . "STANDARD")
      )
   )
   (princ)
)

[dlanorh]

You are trying to create a NEW style with a style name that already exists, hence it is failing. You should modify the style name in the test function to a name other than "Standard" then select all mleaders and change their style to the new mleader style, use the mleader style manager to alter the existing style  or find a lisp program that will alter an existing style rather than creating a new one.

[dbhunia]

For.....

---

@Anonymous wrote:

I have this lisp routine that creates a mleader style but it doesn't change any of the settings such as text height, arrow sizes, etc. At the end of the lisp routine under "(list...", I thought these settings would update the mleader settings but it doesn't. Can anyone help? I'm not an expert in coding by any means.

Thanks

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

---

Try this...... (It is not tested because I am unable to test it in AutoCAD 2007)

;;;
;;; 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"))
	       (setvar "CMLEADERSTYLE" "STANDARD")
            )
            ;(princ "\n ** Error: MLeader style already exists")
            (progn
	       (initget "Y N")
	       (setq CO
    		   (cond ((getkword "\nMLeader style already exists do you want to modify it [Yes/No] <No>: "))
                		   ("N")
    		   )
  	       )
	    (if (= CO "Y")
	     (progn		
               (setq CMS_NewMLeaderStyle (vla-getObject CMS_MLeaderStyles CMS_NewName))
               (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 ** Modified " CMS_NewName " MLeader style"))
	       (setvar "CMLEADERSTYLE" "STANDARD")
	     )
	    )
            )
         )
      )
      (princ "\n ** Error: textstyle does not exist")
   )
   (princ)
)
(defun c:TEST ()
   (CreateMLeaderStyle "STANDARD"
      (list 
         '("ArrowSize"               . 0.08)
         '("DoglegLength"            . 0.035)
         '("LandingGap"              . 0.08)
         '("LeaderLineColor"         . 7)
         (cons "ScaleFactor"         (getvar "DIMSCALE"))
         '("TextColor"               . 7)
         '("TextHeight"              . 0.08)
         '("TextLeftAttachmentType"  . 1)
         '("TextRightAttachmentType" . 1)
         '("TextStyle"               . "STANDARD")
      )
   )
   (princ)
)

For 2nd part.......I think this would be better for you.....

(defun c:TEST ( / MLS)
(setq MLS (getstring T "\nEnter MLeader Style Name to Create a New / Modify an Existing one: "))
   (CreateMLeaderStyle MLS
      (list 
         '("ArrowSize"               . 0.08)
         '("DoglegLength"            . 0.035)
         '("LandingGap"              . 0.08)
         '("LeaderLineColor"         . 3)
         (cons "ScaleFactor"         (getvar "DIMSCALE"))
         '("TextColor"               . 3)
         '("TextHeight"              . 0.15)
         '("TextLeftAttachmentType"  . 1)
         '("TextRightAttachmentType" . 1)
         '("TextStyle"               . "STyle1")
      )
   )
(princ)
)