很容易将所有属性复制到新的MLEADER样式。
这是我关于这个想法的0.02美元：
; 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
然后
(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 drawmleaderordertypeenableblockrotation
enableblockscaleenabledogleg enableframetext enablelanding firstsegmentangleconstraint
landinggap leaderlinecolor leaderlinetype leaderlinetypeid leaderlineweight
maxleadersegmentspoints overwritepropchangedscalefactor secondsegmentangleconstraint
textalignmenttype textangletype textattachmentdirection textbottomattachmenttype
textcolor textheight textleftattachmenttypetextrightattachmenttype
textstring textstyle texttopattachmenttype
); list
nil nil
)
); defun
示例调用：
(MatchMleaderStyleProps "MySourceMleaderStyle" "MyDestinationMleaderStyle")
页:
1
[2]