Sorry for the delay in response... I got pulled away on another project...here is that code you were asking about. it's a compilation of different routines, mostly from the god of LISP, Mr. Lee Mac, with a dash of other people's help, and a smidgen of my own. so it's probably a nightmare to look at, as i'm sure it could be cleaned up and streamlined. i would like to add something to it that will do a regenall and run this routine every time i switch layout tabs... anywho... hope it doesn't give you a migraine or drive you to drinking!
Code:
(defun C:BKVZ (/ ss elst bent aent aentlst aval blklst) ; Define the function, localize the variables
(vl-load-com) ; Load the Visual LISP console (allows vl-... commands)
(if ; If there exists a selection set such that:
(setq ss (ssget "X" ; "X" meaning search entire database for entities with:
(list (cons 0 "INSERT") ; type: INSERT (Blocks, XRefs)
(cons 66 1) ; Attributed
(if (getvar "CTAB") ; If there is a variable "CTAB" (newer releases - determines Model Space/Paper Space
(cons 410 (getvar "CTAB")) ; Then filter by the CTAB variable
(cons 67 (- 1 (getvar "TILEMODE"))) ; Otherwise use TILEMODE variable to filter.
) ; end if
) ; end list [Filter List]
) ; end Selection set aquirement [ssget]
) ; end Variable Setting [Selection set stored in variable "ss"]
(progn ; Wrap the following code for use in the IF statement:
(setq elst ; Store the following list of entity names to variable "eLst"
(vl-remove-if
'listp ; Remove from the list if the item is a List
(mapcar 'cadr ; Produce a list of entity names (and possible coord values) from
(ssnamex ss) ; Information provided by "ssnamex" about the Selection Set
) ; end Mapcar
) ; end vl-remove-if
) ; end variable setting
(foreach e elst ; For Each item (e) in the eLst (entity name list):
(setq bent (cdr (assoc 5 (entget e))) ; Retrieve the Block Name [store to "bEnt"] **** 5 = block handle
aent (entnext e) ; Retrieve the Attribute Entity Name [Store to aEnt]
) ; end Variable setting
(while (= "ATTRIB" (cdr (assoc 0 (setq aentlst (entget aent))))) ; While the Entity Type is "ATTRIB"[ute]
(if (= (cdr (assoc 2 aentlst)) "AFVIZ") ; If the ATTRIBute name is "AFVIZ"
;;;CHANGE "AFVIZ" TO YOUR ATTRIBUTE NAME. NAME ALL OF THE ATTRIBUTES THAT REFERENCE THE EXCEL
;;;SPREADSHEET OR WHATEVER YOU ARE REFERENCING, THE SAME THING. SO THAT THE ROUTINE ONLY LOOKS AT
;;;THE NAME OF THE VISIBILITY PARAMETER THAT YOU WANT TO CHANGE.
(progn ; wrap the following for use with the IF
(setq aval (cdr (assoc 1 aentlst)) ; Store the ATTRIBute value [to aVal]
blklst (cons (cons bent aval) ; Create an Associative list (dotted pair) of Block Name and Att. Value.
blklst) ; Connect this to the main list
) ; End Variable Setting
) ; end Progn (code wrapper)
) ; end IF
(setq aent (entnext aent)) ; Move onto next Attribute in Block
) ; End While
) ; End Foreach
) ; End Progn
(princ "\n<!> No Attributed Blocks Found <!>") ; If No Selection Set, then No Attributed Blocks Found in Drawing.
) ; End IF
;(PROMPT (vl-princ-to-string blkLst)) ; Convert the Associative List to a String and Alert it in a Dialog Box to view result.
(foreach item blklst ; ***** added function here and replaced 'block-record' with 'item' BlkLst should have form ((handle1 . attribute) (handle2 . attribute) ...) but only if ssget can find them!
(if (setq blk (handent (car item)))
(lm:setvisibilitystate (vlax-ename->vla-object blk) (cdr item))
(princ "\nBlock handle not found")))
(princ) ; Exit Cleanly - [Suppress last function return]
) ; End Function
(if (setq sel (ssget "_X" (list '(0 . "INSERT") (cons 2 (strcat "`*U*," blk)))))
(repeat (setq idx (sslength sel))
(if (= (strcase blk) (strcase (LM:blockname (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))))))
(LM:SetVisibilityState obj vis)
)
)
)
(princ)
;; Block Name - Lee Mac
;; Returns the true (effective) name of a supplied block reference
(defun LM:blockname ( obj )
(if (vlax-property-available-p obj 'effectivename)
(defun LM:blockname ( obj ) (vla-get-effectivename obj))
(defun LM:blockname ( obj ) (vla-get-name obj))
)
(LM:blockname obj)
)
;; Get Dynamic Block Property Allowed Values - Lee Mac
;; Returns the allowed values for a specific Dynamic Block property.
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
;; Returns: [lst] List of allowed values for property, else nil if no restrictions
(defun LM:getdynpropallowedvalues ( blk prp )
(setq prp (strcase prp))
(vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'allowedvalues)))
(vlax-invoke blk 'getdynamicblockproperties)
)
);;;;
;; 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 Dynamic Block Properties - Lee Mac
;; Returns an association list of Dynamic Block properties & values.
;; blk - [vla] VLA Dynamic Block Reference object
;; Returns: [lst] Association list of ((<prop> . <value>) ... )
(defun LM:getdynprops ( blk )
(mapcar '(lambda ( x ) (cons (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)))
)
)
;;
;; 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 )
(LM:getdynpropvalue blk (LM:getvisibilityparametername blk))
)
;;
;; Set Dynamic Block Property Value - Lee Mac
;; Modifies the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
;; val - [any] New value for property
;; Returns: [any] New value if successful, else nil
(defun LM:setdynpropvalue ( blk prp val )
(setq prp (strcase prp))
(vl-some
'(lambda ( x )
(if (= prp (strcase (vla-get-propertyname x)))
(progn
(vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
(cond (val) (t))
)
)
)
(vlax-invoke blk 'getdynamicblockproperties)
)
)
;;
;; Set Dynamic Block Properties - Lee Mac
;; Modifies values of Dynamic Block properties using a supplied association list.
;; blk - [vla] VLA Dynamic Block Reference object
;; lst - [lst] Association list of ((<Property> . <Value>) ... )
;; Returns: nil
(defun LM:setdynprops ( blk lst / itm )
(setq lst (mapcar '(lambda ( x ) (cons (strcase (car x)) (cdr x))) lst))
(foreach x (vlax-invoke blk 'getdynamicblockproperties)
(if (setq itm (assoc (strcase (vla-get-propertyname x)) lst))
(vla-put-value x (vlax-make-variant (cdr itm) (vlax-variant-type (vla-get-value x))))
)
)
)
;;;;;;;
;; Set Dynamic Block Visibility State - Lee Mac
;; Sets the Visibility Parameter of a Dynamic Block (if present) to a specific value (if allowed)
;; blk - [vla] VLA Dynamic Block Reference object
;; val - [str] Visibility State Parameter value
;; Returns: [str] New value of Visibility Parameter, else nil
(defun LM:SetVisibilityState ( blk val / vis )
(if
(and
(setq vis (LM:getvisibilityparametername blk))
(member (strcase val) (mapcar 'strcase (LM:getdynpropallowedvalues blk vis)))
)
(LM:setdynpropvalue blk vis val)
)
)
;;;;
(PRINC)