Leaderboard

Try the following code: (defun c:matchblock ( / att blk ent idx lst obj par sel vis ) (while (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect source block <exit>: "))) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (null ent) nil) ( (/= "AcDbBlockReference" (vla-get-objectname (setq obj (vlax-ename->vla-object ent)))) (princ "\nThe selected object is not a block.") ) ( (= :vlax-false (vla-get-hasattributes obj) (vla-get-isdynamicblock obj)) (princ "\nThe selected block is neither attributed nor dynamic.") ) ) ) ) (if (and ent (setq sel (LM:ssget "\nSelect target blocks <exit>: " '("_:L" ((0 . "INSERT")))))) (progn (setq obj (vlax-ename->vla-object ent) att (LM:vl-getattributevalues obj) vis (LM:getvisibilitystate obj) ) (repeat (setq idx (sslength sel)) (setq idx (1- idx) obj (vlax-ename->vla-object (ssname sel idx)) ) (if att (LM:vl-setattributevalues obj att)) (if (and vis (= :vlax-true (vla-get-isdynamicblock obj)) (or (setq blk (strcase (LM:effectivename obj)) par (cdr (assoc blk lst)) ) (and (setq par (LM:getvisibilityparametername obj)) (setq lst (cons (cons blk par) lst)) ) ) ) (vl-some '(lambda ( prp ) (if (and (= par (vla-get-propertyname prp)) (member vis (vlax-get prp 'allowedvalues)) ) (vla-put-value prp (vlax-make-variant vis (vlax-variant-type (vla-get-value prp)))) ) ) (vlax-invoke obj 'getdynamicblockproperties) ) ) ) ) ) (princ) ) ;; Effective Block Name - Lee Mac ;; obj - [vla] VLA Block Reference object (defun LM:effectivename ( obj ) (vlax-get-property obj (if (vlax-property-available-p obj 'effectivename) 'effectivename 'name ) ) ) ;; Get Attribute Values - Lee Mac ;; Returns an association list of attributes present in the supplied block. ;; blk - [vla] VLA Block Reference Object ;; Returns: [lst] Association list of ((<tag> . <value>) ... ) (defun LM:vl-getattributevalues ( blk ) (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) ) ;; Set Attribute Values - Lee Mac ;; Sets attributes with tags found in the association list to their associated values. ;; blk - [vla] VLA Block Reference Object ;; lst - [lst] Association list of ((<tag> . <value>) ... ) ;; Returns: nil (defun LM:vl-setattributevalues ( blk lst / itm ) (foreach att (vlax-invoke blk 'getattributes) (if (setq itm (assoc (vla-get-tagstring att) lst)) (vla-put-textstring att (cdr itm)) ) ) ) ;; Get Dynamic Block Visibility State - Lee Mac ;; Returns the value of the Visibility Parameter of a Dynamic Block (if present) ;; blk - [vla] VLA Dynamic Block Reference object ;; Returns: [str] Value of Visibility Parameter, else nil (defun LM:getvisibilitystate ( blk / vis ) (if (setq vis (LM:getvisibilityparametername blk)) (LM:getdynpropvalue blk vis) ) ) ;; Get Dynamic Block Property Value - Lee Mac ;; Returns the value of a Dynamic Block property (if present) ;; blk - [vla] VLA Dynamic Block Reference object ;; prp - [str] Dynamic Block property name (case-insensitive) (defun LM:getdynpropvalue ( blk prp ) (setq prp (strcase prp)) (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value))) (vlax-invoke blk 'getdynamicblockproperties) ) ) ;; Get Visibility Parameter Name - Lee Mac ;; Returns the name of the Visibility Parameter of a Dynamic Block (if present) ;; blk - [vla] VLA Dynamic Block Reference object ;; Returns: [str] Name of Visibility Parameter, else nil (defun LM:getvisibilityparametername ( blk / vis ) (if (and (vlax-property-available-p blk 'effectivename) (setq blk (vla-item (vla-get-blocks (vla-get-document blk)) (vla-get-effectivename blk) ) ) (= :vlax-true (vla-get-isdynamicblock blk)) (= :vlax-true (vla-get-hasextensiondictionary blk)) (setq vis (vl-some '(lambda ( pair ) (if (and (= 360 (car pair)) (= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair))))) ) (cdr pair) ) ) (dictsearch (vlax-vla-object->ename (vla-getextensiondictionary blk)) "ACAD_ENHANCEDBLOCK" ) ) ) ) (cdr (assoc 301 (entget vis))) ) ) ;; ssget - Lee Mac ;; A wrapper for the ssget function to permit the use of a custom selection prompt ;; msg - [str] selection prompt ;; arg - [lst] list of ssget arguments (defun LM:ssget ( msg arg / sel ) (princ msg) (setvar 'nomutt 1) (setq sel (vl-catch-all-apply 'ssget arg)) (setvar 'nomutt 0) (if (not (vl-catch-all-error-p sel)) sel) ) (vl-load-com) (princ)