|
Lze, ale není to úplně triviální. Zde je příklad kódu od Lee Maca (dotaz na soubor bloku jde nahradit dotazem na jméno bloku, stav viditelnosti lze zvolit také přímým zadáním jména):
;Lee Mac
(defun c:InsertDyn ( / *error* att blk def doc ent new obj par spc tmp vis )
(defun *error* ( msg )
(if (= 'int (type att))
(setvar 'attreq att)
)
(foreach obj (list new def)
(if (and (= 'vla-object (type obj)) (not (vlax-erased-p obj)))
(vl-catch-all-apply 'vla-delete (list obj))
)
)
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(cond
( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
(princ "\nCurrent layer locked.")
)
( (null (setq blk (getfiled "Select Dynamic Block with Visibility States" "" "dwg" 16)))
(princ "\n*Cancel*")
)
( (progn
(setq doc (vla-get-activedocument (vlax-get-acad-object))
spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
obj (vlax-invoke spc 'insertblock '(0.0 0.0 0.0) blk 1.0 1.0 1.0 0.0)
)
(vla-put-visible obj :vlax-false)
(= :vlax-false (vla-get-isdynamicblock obj))
)
(princ "\nSelected block is not dynamic.")
(vla-delete obj)
)
( (null (setq par (LM:getvisibilityparametername obj)))
(princ "\nSelected block does not have a visibility parameter.")
(vla-delete obj)
)
( (null (setq vis (car (LM:listbox "Choose a Visibility State" (acad_strlsort (LM:getdynpropallowedvalues obj par)) 0))))
(princ "\n*Cancel*")
(vla-delete obj)
)
( t
(LM:setdynpropvalue obj par vis)
(setq tmp 0)
(while (tblsearch "block" (setq blk (strcat "tmp" (itoa (setq tmp (1+ tmp)))))))
(vla-put-visible
(car
(vlax-invoke doc
'copyobjects
(list obj)
(setq def (vlax-invoke (vla-get-blocks doc) 'add '(0.0 0.0 0.0) blk))
)
)
:vlax-true
)
(vla-delete obj)
(setq ent (entlast)
att (getvar 'attreq)
)
(setvar 'attreq 0)
(if
(and
(vl-cmdf "_.-insert" blk "_S" 1.0 "_R" 0.0 "\\")
(not (eq ent (setq ent (entlast))))
(= "AcDbBlockReference" (vla-get-objectname (setq new (vlax-ename->vla-object ent))))
)
(progn
(vla-explode new)
(vla-delete new)
)
)
(vl-catch-all-apply 'vla-delete (list def))
)
)
(princ)
)
;; 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 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)
)
)
;; 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)
)
)
;; List Box - Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil
(defun LM:listbox ( msg lst bit / dch des tmp rtn )
(cond
( (not
(and
(setq tmp (vl-filename-mktemp nil nil ".dcl"))
(setq des (open tmp "w"))
(write-line
(strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
(if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
)
des
)
(not (close des))
(< 0 (setq dch (load_dialog tmp)))
(new_dialog "listbox" dch)
)
)
(prompt "\nError Loading List Box Dialog.")
)
( t
(start_list "list")
(foreach itm lst (add_list itm))
(end_list)
(setq rtn (set_tile "list" "0"))
(action_tile "list" "(setq rtn $value)")
(setq rtn
(if (= 1 (start_dialog))
(if (= 2 (logand 2 bit))
(read (strcat "(" rtn ")"))
(mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
)
)
)
)
)
(if (< 0 dch)
(unload_dialog dch)
)
(if (and tmp (setq tmp (findfile tmp)))
(vl-file-delete tmp)
)
rtn
)
(vl-load-com) (princ)
-------------
Vladimír Michl (moderátor)
ARKANCE CZ - https://arkance.world - arkance.world
(podpora viz emea.support.arkance.world)
|