Jump to content

LISP for creating MLeader Style


ryankevin15
 Share

Recommended Posts

Here's a start .. you'll need to find all the properties you want to change and add them.

 

(defun _makemleaderstyle (name txtstyle / d mld mlo)
 ;; RJP - 09.16.2017
 (if
   (and
     (setq d (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))))
     (= 'vla-object (type (setq mld (vl-catch-all-apply 'vla-item (list d "ACAD_MLEADERSTYLE")))))
     (= 'vla-object
 (type
   (setq mlo (vl-catch-all-apply 'vlax-invoke (list mld 'addobject name "AcDbMLeaderStyle")))
 )
     )
   )
    (progn (vla-put-alignspace mlo 0.1)
    (vla-put-annotative mlo :vlax-true)
    (vla-put-arrowsize mlo 0.18)
    (vla-put-blockconnectiontype mlo 0)
    (vla-put-breaksize mlo 0.1)
    (vla-put-description mlo "")
    (vla-put-dogleglength mlo 0.125)
    (vla-put-enablelanding mlo :vlax-true)
    (vla-put-firstsegmentangleconstraint mlo 0)
    (vla-put-landinggap mlo 0.05)
    (vla-put-maxleadersegmentspoints mlo 2)
    (vla-put-scalefactor mlo 1)
    (vla-put-secondsegmentangleconstraint mlo 0)
    (vlax-put mlo 'textalignmenttype 0)
    (vlax-put mlo 'textleftattachmenttype 1)
    (vlax-put mlo 'textrightattachmenttype 1)
    (vla-put-textheight mlo 0.1)
    ;; Make sure you load your texstyle first or it will default to standard
    (vla-put-textstyle
      mlo
      (if (tblobjname "style" txtstyle)
	txtstyle
	"standard"
      )
    )
    mlo
    )
 )
)
;; (_makemleaderstyle "Bazinga!" "Standard")
(vl-load-com)
;; Properties below

				; IAcadMLeaderStyle: AutoCAD MLeaderStyle Interface
				; Property values:
				;   AlignSpace = 5.0
				;   Annotative = 0
				;   Application (RO) = #<VLA-OBJECT IAcadApplication 00007ff701d75188>
				;   ArrowSize = 0.18
				;   ArrowSymbol = ""
				;   BitFlags = 0
				;   Block = ""
				;   BlockColor = #<VLA-OBJECT IAcadAcCmColor 0000022367bcf870>
				;   BlockConnectionType = 0
				;   BlockRotation = 0.0
				;   BlockScale = 1.0
				;   BreakSize = 0.125
				;   ContentType = 2
				;   Description = ""
				;   Document (RO) = #<VLA-OBJECT IAcadDocument 0000022358e47788>
				;   DoglegLength = 2.0
				;   DrawLeaderOrderType = 0
				;   DrawMLeaderOrderType = 1
				;   EnableBlockRotation = -1
				;   EnableBlockScale = -1
				;   EnableDogleg = -1
				;   EnableFrameText = 0
				;   EnableLanding = -1
				;   FirstSegmentAngleConstraint = 0
				;   Handle (RO) = "2FA"
				;   HasExtensionDictionary (RO) = 0
				;   LandingGap = 0.4
				;   LeaderLineColor = #<VLA-OBJECT IAcadAcCmColor 0000022367bcf690>
				;   LeaderLinetype = 1
				;   LeaderLineTypeId = AutoCAD.Application: Null object ID
				;   LeaderLineWeight = -2
				;   MaxLeaderSegmentsPoints = 2
				;   Name = "test"
				;   ObjectID (RO) = 3212
				;   ObjectName (RO) = "AcDbMLeaderStyle"
				;   OverwritePropChanged (RO) = 0
				;   OwnerID (RO) = 2921
				;   ScaleFactor = 1.0
				;   SecondSegmentAngleConstraint = 0
				;   TextAlignmentType = 0
				;   TextAngleType = 0
				;   TextAttachmentDirection = 0
				;   TextBottomAttachmentType = 0
				;   TextColor = #<VLA-OBJECT IAcadAcCmColor 0000022367bcf6f0>
				;   TextHeight = 0.2
				;   TextLeftAttachmentType = 2
				;   TextRightAttachmentType = 3
				;   TextString = ""
				;   TextStyle = AutoCAD.Application: Null object ID
				;   TextTopAttachmentType = 0
				; Methods supported:
				;   Delete ()
				;   GetExtensionDictionary ()
				;   GetXData (3)
				;   SetXData (2)

Link to comment
Share on other sites

Here's a start .. you'll need to find all the properties you want to change and add them.

 

(defun _makemleaderstyle (name txtstyle / d mld mlo)
 ;; RJP - 09.16.2017
 (if
   (and
     (setq d (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))))
     (= 'vla-object (type (setq mld (vl-catch-all-apply 'vla-item (list d "ACAD_MLEADERSTYLE")))))
     (= 'vla-object
 (type
   (setq mlo (vl-catch-all-apply 'vlax-invoke (list mld 'addobject name "AcDbMLeaderStyle")))
 )
     )
   )
    (progn (vla-put-alignspace mlo 0.1)
    (vla-put-annotative mlo :vlax-true)
    (vla-put-arrowsize mlo 0.18)
    (vla-put-blockconnectiontype mlo 0)
    (vla-put-breaksize mlo 0.1)
    (vla-put-description mlo "")
    (vla-put-dogleglength mlo 0.125)
    (vla-put-enablelanding mlo :vlax-true)
    (vla-put-firstsegmentangleconstraint mlo 0)
    (vla-put-landinggap mlo 0.05)
    (vla-put-maxleadersegmentspoints mlo 2)
    (vla-put-scalefactor mlo 1)
    (vla-put-secondsegmentangleconstraint mlo 0)
    (vlax-put mlo 'textalignmenttype 0)
    (vlax-put mlo 'textleftattachmenttype 1)
    (vlax-put mlo 'textrightattachmenttype 1)
    (vla-put-textheight mlo 0.1)
    ;; Make sure you load your texstyle first or it will default to standard
    (vla-put-textstyle
      mlo
      (if (tblobjname "style" txtstyle)
	txtstyle
	"standard"
      )
    )
    mlo
    )
 )
)
;; (_makemleaderstyle "Bazinga!" "Standard")
(vl-load-com)
;; Properties below

				; IAcadMLeaderStyle: AutoCAD MLeaderStyle Interface
				; Property values:
				;   AlignSpace = 5.0
				;   Annotative = 0
				;   Application (RO) = #<VLA-OBJECT IAcadApplication 00007ff701d75188>
				;   ArrowSize = 0.18
				;   ArrowSymbol = ""
				;   BitFlags = 0
				;   Block = ""
				;   BlockColor = #<VLA-OBJECT IAcadAcCmColor 0000022367bcf870>
				;   BlockConnectionType = 0
				;   BlockRotation = 0.0
				;   BlockScale = 1.0
				;   BreakSize = 0.125
				;   ContentType = 2
				;   Description = ""
				;   Document (RO) = #<VLA-OBJECT IAcadDocument 0000022358e47788>
				;   DoglegLength = 2.0
				;   DrawLeaderOrderType = 0
				;   DrawMLeaderOrderType = 1
				;   EnableBlockRotation = -1
				;   EnableBlockScale = -1
				;   EnableDogleg = -1
				;   EnableFrameText = 0
				;   EnableLanding = -1
				;   FirstSegmentAngleConstraint = 0
				;   Handle (RO) = "2FA"
				;   HasExtensionDictionary (RO) = 0
				;   LandingGap = 0.4
				;   LeaderLineColor = #<VLA-OBJECT IAcadAcCmColor 0000022367bcf690>
				;   LeaderLinetype = 1
				;   LeaderLineTypeId = AutoCAD.Application: Null object ID
				;   LeaderLineWeight = -2
				;   MaxLeaderSegmentsPoints = 2
				;   Name = "test"
				;   ObjectID (RO) = 3212
				;   ObjectName (RO) = "AcDbMLeaderStyle"
				;   OverwritePropChanged (RO) = 0
				;   OwnerID (RO) = 2921
				;   ScaleFactor = 1.0
				;   SecondSegmentAngleConstraint = 0
				;   TextAlignmentType = 0
				;   TextAngleType = 0
				;   TextAttachmentDirection = 0
				;   TextBottomAttachmentType = 0
				;   TextColor = #<VLA-OBJECT IAcadAcCmColor 0000022367bcf6f0>
				;   TextHeight = 0.2
				;   TextLeftAttachmentType = 2
				;   TextRightAttachmentType = 3
				;   TextString = ""
				;   TextStyle = AutoCAD.Application: Null object ID
				;   TextTopAttachmentType = 0
				; Methods supported:
				;   Delete ()
				;   GetExtensionDictionary ()
				;   GetXData (3)
				;   SetXData (2)

 

I'm not sure I understand what you, mean... It looks like you have the properties listed there... Which properties are missing from this? Or are you saying I just need to change what is there to what I want to see in an MLeader?

Link to comment
Share on other sites

And, when I run this it says "Error too few arguments" and shouldn't the first have an alias with c:? (defun _makemleaderstyle (name txtstyle / d mld mlo)

Link to comment
Share on other sites

The function accepts a name and textsyle (_makemleaderstyle "Alpha" "Ascent") .. I added some of the properties, but there may be more needed for the style you're creating.

 

IMO .. it's much easier to have a template that contains all your styles then start with that, or insert it as a block.

Link to comment
Share on other sites

The function accepts a name and textsyle (_makemleaderstyle "Alpha" "Ascent") .. I added some of the properties, but there may be more needed for the style you're creating.

 

IMO .. it's much easier to have a template that contains all your styles then start with that, or insert it as a block.

 

Yeah we have a template and added our mleader style... I guess the reason we wanted this was so that whenever we open a drawing, the ascent mleaderstyle is automatically in the drawing already and set to current... but I think we can get around this by just having it already in the template though...

Link to comment
Share on other sites

Yeah we have a template and added our mleader style... I guess the reason we wanted this was so that whenever we open a drawing, the ascent mleaderstyle is automatically in the drawing already and set to current... but I think we can get around this by just having it already in the template though...

Add something like this to your startup:

(command "_.insert" "fullpathtotemplate" nil)
(setvar 'cmleaderstyle "Alpha")

Link to comment
Share on other sites

Doesn't look like that code worked... says nil when executed.

It will always return nil (command "_.insert" "fullpathtotemplate" nil) .. make sure you put the full path to your template if it's not in your search paths.

Link to comment
Share on other sites

It will be easy to replicate all property to the new MLEADER STYLE .

 

 

Here are mine 0.02$ about this idea:

 

; s - Source VLA-OBJECT (graphical/non-graphical)
; d - Destination VLA-OBJECT (graphical/non-graphical)
; ps - predefined properties list to use, if nil the (atoms-family) properties approach will be used
; aps - properties list to include for matching, since (atoms-family) is missing some of them
; rps - properties list to remove from matching
; Returns: assoc list of (<PropertyName> <MatchedValue>) for the error-free assigned properties
; Wanna credits?: Lee Mac, Michael Puckett
(defun _MatchProps ( s d ps aps rps / TrapT )
 (cond 
   ( (or (vl-some '(lambda (x) (not (eq 'VLA-OBJECT (type x)))) (list s d)) (not (vlax-read-enabled-p s)) (not (vlax-write-enabled-p d))) nil)
   (
     (and
       (if ps ; determine predefined properties to use or (atoms-family)
         (setq ps (mapcar '(lambda (p) (cond ((eq 'SYM (type p)) (vl-symbol-name p)) ((eq 'STR (type p)) (strcase p)))) ps))
         (setq ps (apply 'append (mapcar '(lambda (x) (if (wcmatch (setq x (strcase x)) "VLA-PUT-*") (list (vl-string-left-trim "VLA-PUT-" x)))) (atoms-family 1))))
       )
       (setq ps (append (if aps (mapcar '(lambda (p) (cond ((eq 'SYM (type p)) (vl-symbol-name p)) ((eq 'STR (type p)) (strcase p)))) aps)) ps)) ; additional
       (setq ps (apply 'append (mapcar '(lambda (p) (if (vl-every '(lambda (x) (vlax-property-available-p x p t)) (list s d)) (list p))) ps))) ; check valid props
       (cond ; check for removal
         (rps 
           (setq rps (apply 'append (mapcar '(lambda (p) (cond ((eq 'SYM (type p)) (list (vl-symbol-name p))) ((eq 'STR (type p)) (list (strcase p))))) rps)))
           (setq ps (vl-remove-if '(lambda (p) (member p rps)) ps))
         )
         ( ps )
       )
     ); and
     (setq TrapT ; Traps the evaluation only: returns nil only if an error occured, else the value or T
       (lambda (f args / r) (cond ( (vl-catch-all-error-p (setq r (vl-catch-all-apply f args))) (prompt (strcat "\nError: " (vl-catch-all-error-message r))) ) (r) ((not r)) ) )
     ); setq TrapT
     (mapcar '(lambda (p / v) (cond ( (not (setq v (TrapT 'vlax-get-property (list s p)))) v) ( (not (TrapT 'vlax-put-property (list d p v))) nil) ( (list p v) ) ) ) ps)
   )
 ); cond
); defun _MatchProps

 

Then...

 

(defun MatchMleaderStyleProps ( snm dnm / coll )
 (setq coll (vla-item (vla-get-Dictionaries (vla-get-ActiveDocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE"))
 (_MatchProps (vl-catch-all-apply 'vla-item (list coll snm)) (vl-catch-all-apply 'vla-item (list coll dnm))
   '(
     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 overwritepropchanged  scalefactor secondsegmentangleconstraint
     textalignmenttype textangletype textattachmentdirection textbottomattachmenttype
     textcolor textheight textleftattachmenttype  textrightattachmenttype
     textstring textstyle texttopattachmenttype
   ); list 
   nil nil
 )
); defun

 

Example call:

 

(MatchMleaderStyleProps "MySourceMleaderStyle" "MyDestinationMleaderStyle")

Link to comment
Share on other sites

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.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

×
×
  • Create New...