Jump to content

dynamic block visibility lisp


jetxcc

Recommended Posts

Hello all,

I've posted on SEVERAL forums trying to get an answer to this problem, I've compiled so many different Lisp routines that I've lost count, but none have quite been able to do what i want. i've attached a dwg with two blocks in it, the scope of what I'm trying to accomplish is at the bottom of this code:

 

 

 

 

(defun BKVZ ( / blk idx obj sel vis )
   
   (setq blk "WELD DETAIL" ;; Block Name
         vis "EQUAL WELD"  ;; New Visibility State
   )
   (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)
)

;; I would like the visibility state of several different dynamic blocks

;; to reference a text field within the drawing, and the blk variable to be used for several different dynamic

;; blocks within my drawing. for example in this drawing i have two dynamic blocks, and two text fields that

;; represent the visibility states that i want to use for the blocks (this value will change so i want to use it as a

;; variable to change the db viz prop) . I would like to be able to use this code to change the vis states of

;; several blocks within the same dwg, each of which would have a text field that will display the present vis state.

;; if i have to use setq blk1, blk2, blk3, etc to represent each block that is fine, but with several different possible

;; vis states, i would like that varible to reference the text field. so as the text field changes, so does the vis state of the

;; dynamic block.

 

ANY HELP WOULD BE APPRECIATED. THANK YOU!!

NEW-LISP-TRIAL.dwg

Edited by SLW210
Link to comment
Share on other sites

  • Replies 26
  • Created
  • Last Reply

Top Posters In This Topic

  • rlx

    9

  • jetxcc

    9

  • jgarner33

    4

  • SLW210

    2

Top Posters In This Topic

@SLW210 My apologies.

 

Hello all,

I've posted on SEVERAL forums trying to get an answer to this problem, I've compiled so many different Lisp routines that I've lost count, but none have quite been able to do what i want. i've attached a dwg with two blocks in it, the scope of what I'm trying to accomplish is at the bottom of this code:

 

(defun BKVZ ( / blk idx obj sel vis )

(setq blk "WELD DETAIL" ;; Block Name
vis "EQUAL WELD" ;; New Visibility State
)
(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)
)

 

I would like the visibility state of several different dynamic blocks to reference a text field within the drawing, OR an attribute field within the block, and the blk variable to be used for several different dynamic

;; blocks within my drawing. for example in this drawing i have two dynamic blocks, and two text fields that

;; represent the visibility states that i want to use for the blocks (this value will change so i want to use it as a

;; variable to change the db viz prop) . I would like to be able to use this code to change the vis states of

;; several blocks within the same dwg, each of which would have a text field that will display the present vis state.

;; if i have to use setq blk1, blk2, blk3, etc to represent each block that is fine, but with several different possible

;; vis states, i would like that varible to reference the text field. so as the text field changes, so does the vis state of the

;; dynamic block.

 

ANY HELP WOULD BE APPRECIATED. THANK YOU!!

Link to comment
Share on other sites

SO AT LONG LAST... I HAVE IT!!! well.... ALMOST!!!

Need help with this one last thing....

when this code is ran in a dwg with dynamic blocks that has attributes it puts out a list of dotted pairs in the format (block handle . attribute value) Here is the output for my particular dwg. after running the code.

 

((1153D . FULL PEN-6-HOLE) (1154E . EQ. WELD) (1216E . NO HOLE) (12DD5 . VERT-STRAIGHT(>/= 10.75 O.D.)) (1FD4A . SC1) (201C5 . EQ. WELD))

 

 

 

(defun StVz (/ 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"]
         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"
       (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.
 (princ) ; Exit Cleanly - [suppress last function return]
) ; End Function

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

I want to combine the above code with THIS code to set the dynamic block, that's listed by its handle, the first element of the pairs, to the visibility state that is the attribute value, the second element of the pairs, the vis state is a field that references an Excel worksheet entry. In the following code towards the top, there is a setq blk function with that says "WELD DETAIL" I would like the first element of each pair to be put into this place. and for the setq vis function "EQUAL WELD" I would like the second element of the list to be here, as this tells the following code what to change the visibility to. Both of these codes work independently, but the second one has to have the values put into them at the top to tell it WHICH block and WHICH visibility state to apply it to. I would like these two codes to run in tandem without any user input, and applicable to ALL dynamic blocks within the dwg. SSSOOOOooooo..... my question is.... how do I get that to happen?

 

(defun BkVz ()

   (setq blk "WELD DETAIL" ;; Block Name
         vis "EQUAL WELD"    ;; New Visibility State
   )
   (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)
)

;; 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)
   )
)

;; 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)
   )
)

;; 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 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)))
   )
)

(vl-load-com) (princ)

THANK YOU TO ANYONE THAT CAN OR TRIES TO HELP OR OFFERS SUGGESTIONS!!

Link to comment
Share on other sites

totally untested and assuming your list is valid

 

 



(defun tst ( / in-my-list block-record blk )
 (setq in-my-list 
    '(("1153D" . "FULL PEN-6-HOLE")  ("1154E" . "EQ. WELD") ("1216E" . "NO HOLE")
       ("12DD5" . "VERT-STRAIGHT(>/= 10.75 O.D.)") ("1FD4A" . "SC1") ("201C5" . "EQ. WELD")))
 (foreach block-record in-my-list
   (if (setq blk (handent (car block-record)))
     (LM:SetVisibilityState (vlax-ename->vla-object blk) (cdr block-record))
     (princ "\nBlock handle not found")
   )
 )
)


Edited by rlx
Link to comment
Share on other sites

  • 2 weeks later...

RLX.... we... (you) are sooo close!!!! that worked beautifully!!! except that I want the list that is produced by the first code to take the place of the list I provided, since every dwg will have different blocks, with different names and so forth. The list

""'(("1153D" . "FULL PEN-6-HOLE") ("1154E" . "EQ. WELD") ("1216E" . "NO HOLE")("12DD5" . "VERT-STRAIGHT(>/= 10.75 O.D.)") ("1FD4A" . "SC1") ("201C5" . "EQ. WELD")))""

was just the current output of the blocks in the dwg that i am working on. how do i get your code to look at the associated list produced by the first code? I hope that makes sense...

Link to comment
Share on other sites

still not fully recoverd from xmas and new year so not operating at peak efficiency... but if I understand correctly you just want to pass the list generated from your 1st code as a parameter to the last code?

 

(defun tst ( your-list / block-record blk )
 (foreach block-record your-list
   (if (setq blk (handent (car block-record)))
     (LM:SetVisibilityState (vlax-ename->vla-object blk) (cdr block-record))
     (princ "\nBlock handle not found")
    )
 )
)

 

just use : (tst your-list)

 

but its late and I have a dangerously low concentration of red wine in my blood so maybe I'm thinking to simple right now?

 

gr. Rlx

Link to comment
Share on other sites

lol. I totally understand!! had a rough one myself!!

 

and yes, the resulting list of running the first code the one that starts with the (defun StVz) I think my other code (defun BkVz) is obsolete using your code. I'm not sure which list I need to use as the variable in your code. In the STVZ code it creates 5 different list called eLst, bEnt, Aent, aEntLst, and blkLst. I assumed that the list that I needed to put in place of "your-list" would be blkLst. but that doesn't seem to be the case. I've tried the others as well, with no luck. I'm sure it's something stupidly simple...but I can't hammer it down....

Link to comment
Share on other sites

lol. I totally understand!! had a rough one myself!!

 

and yes, the resulting list of running the first code the one that starts with the (defun StVz) I think my other code (defun BkVz) is obsolete using your code. I'm not sure which list I need to use as the variable in your code. In the STVZ code it creates 5 different list called eLst, bEnt, Aent, aEntLst, and blkLst. I assumed that the list that I needed to put in place of "your-list" would be blkLst. but that doesn't seem to be the case. I've tried the others as well, with no luck. I'm sure it's something stupidly simple...but I can't hammer it down....

 

I have no drawing to test your routine because the one from your first post just gives "\n No Attributed Blocks Found " but the list to use should be BlkLst

 

(defun stvz  (/ 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"
        (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

 

well almost time for bed for me ... gr. Rlx

Link to comment
Share on other sites

YOU SIR ARE A GOD AMONGST MEN!!! That little snippet of code was EXACTLY what i needed to complete the 6+ month daunting task!!! I will post the completed code after I clean it up a little. Words cannot express the depths of my gratitude!! But Thank you!!

Link to comment
Share on other sites

The final and completed code!!!! use it wisely...with great power comes...REALLY COOL STUFF!!!

 

 

(defun STVZ  (/ 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)
)

;; 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)
   )
)

;; 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)
   )
)

;; 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 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)))
   )
)

(vl-load-com) (princ)

;;;HUGE THANKS TO LEE MAC FOR ALL OF HIS PROGRAMMING GENIUS. HIS WEBSITE IS AN INVALUABLE SOURCE OF KNOWLEDGE.
;;;THANKS TO RAPIDCAD FROM AUTODESK FORUMS FOR GETTING ME STATED DOWN THE RIGHT PATH.
;;;AND A SUPER HUGE THANK YOU TO RLX FROM CADTUTOR.COM FOR HELPING ME PIECE IT ALL TOGETHER.
;;;
;;;OTHER GOOD SOURCES OF INFO ON AUTOLISP:
;;;
;;;LEE-MAC.COM 
;;;CADTUTOR.COM
;;;AUGI.COM
;;;forums.autodesk.com
;;;AFRALISP.COM
;;;THE SWAMP.COM
;;;jefferypsanders.com (lots of cool little lisp programs and tools)
;;;
;;;THERE HAVE BEEN SEVERAL PEOPLE THAT HAVE HAD THEIR HANDS IN THIS PARTICULAR PIECE OF CODE.
;;;THANK YOU ALL!!!

Link to comment
Share on other sites

Well done rlx! :beer:

 

 

Thank you Dadgad! But I really didn't do that much , 99% of the code has been cut-copied-pasted-googled-created by JetXcc :P

 

 

gr. Rlx

Edited by rlx
Link to comment
Share on other sites

Thank you Dadgad! But I really didn't do that much , 99% of the code has been cut-copied-pasted-googled-created by JetXcc :P

 

 

gr. Rlx

 

Be that as it may, your small contribution has brought to fruition a labor of 6 months, bravo! :beer:

Link to comment
Share on other sites

Although I'm not native to the English language but what a beautiful sentence

 

 

Be that as it may, your small contribution has brought to fruition a labor of 6 months

 

 

is your last name Shakespeare by any chance? :lol:

 

 

gr. Rlx

Link to comment
Share on other sites

The final and completed code!!!! use it wisely...with great power comes...REALLY COOL STUFF!!!

 

 

 

 

Would you be willing to provide a DWG or screenshot on youtube to share some of it?

*EDIT sorry, i see you posted a DWG (before state) in the first post already*

**EDIT can't really figure out what it does exactly. .. I'm more of a do'er, not a reader .. :P

 

 

Command: (stvz)

No Attributed Blocks Found

 

 

*

Link to comment
Share on other sites

  • 3 months later...

Hello All,

 

After much searching and practically zero experience modifying lisp routines, I find myself here. I believe the result of your collaborations can be altered slightly to execute my task at hand.

 

I currently maintain around 600 layouts that contain dynamic blocks that I perform a visibility change each fall and spring. Rather than opening each file and manually changing the block visibility state, this code (I think) can be altered to do so. The plan would be to utilize this lisp routine within an existing visual basic code that would automate the entire process from start to finish following up with a new print of the updated layout.

 

Currently, there are two blocks that need to have the visibility state changed:

 

Current block name: Seasonal-Soils & Fertilizers-884-Master

Current visibility state: SOIL & GDN FRTLIZER

Desired visibility state: CANNING

 

Current block name: Seasonal-Canning-872-Master

Current visibility state: CANNING

Desired visibility state: SOIL & GDN FRTLIZER

 

If you are able to provide some detail as to how I can alter your existing routine to perform my task at hand, I would greatly appreciate it. I've pieced together the following but upon executing the command, nothing happens. I'm not sure if that problem is because I haven't saved each "LM:" sub routine to my C: drive or what it could be. Again, I am just learning/trying to teach myself LISP to assist in the automation of our ever-growing number of layout changes.

 


(defun c:STC884 ( / blk idx obj sel vis )
   
   (setq blk "Seasonal-Soils & Fertilizers-884-Master" ;; Block Name
         vis "CANNING"    ;; New Visibility State
   )
(vl-load-com)
   (if (setq sel (ssget "_X" (list '(0 . "INSERT") (cons 2 (strcat "`*U*," blk)) '(410 . "~Model"))))
       (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)
)

;; 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)
   )
)

;; 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)
   )
)

;; 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 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)))
   )
)

(vl-load-com) (princ)

Edited by SLW210
Added Code Tags.
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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
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.


×
×
  • Create New...