如何使用 AutoLISP 插入具有自定义属性的块?

How to insert a block with custom properties using AutoLISP?

我正在尝试插入具有自定义属性的块。如何设置这些变量?

在 Deciduuous 块中有一个名为 "visibility" 的自定义 属性,具有各种不同的样式(Visibility 1、Visibility 2、Visibility 3,...)。

例如,我将如何插入可见度为 3 的落叶林块。

(DEFUN C:TREE ( / DECIDUOUS CONIFER SHRUBMEDIUM SHRUBSMALL)
  (INITGET 1 "DECIDUOUS CONIFER SHRUBMEDIUM SHRUBSMALL")
  (OR
    (SETQ RETKWORD (GETKWORD "\nSpecify tree type: [DECIDUOUS/CONIFER/SHRUBMEDIUM/SHRUBSMALL]:"))
    (SETQ RETKWORD "DECIDUOUS")
    )
  (IF (= RETKWORD "DECIDUOUS")
    (PROGN
      (SETQ OLDLAYER (GETVAR "CLAYER"))
      (SETQ FLAG (TBLSEARCH "LAYER" "L-PLNT-DECD"))
      (IF FLAG
    (SETVAR "CLAYER" "L-PLNT-DECD")
    )
      (INITGET 1 "Visibility1 Visibility2 Visibility3")
      (OR
    (SETQ CMDKWORD (GETKWORD "\nPick a command: [Visibility1/Visibility2/Visibility3]:"))
    )
      (IF (= CMDKWORD "Visibility3")
    (PROGN
      (COMMAND "INSERT"
           "TT-L-TREE-DECIDUOUS"
           )
      )
    )
      (PRINC)
      )
    )
  )

具有自定义属性的块称为动态块。 详情和示例您可以找到 here

p.s。 谢谢@LeeMac

这个问题的答案最终取决于您是否需要 AutoCAD INSERT 命令提供的插入块参考的 视觉预览

由于标准 AutoCAD INSERT 命令在块插入期间不提示输入动态块参数值,因此您需要插入块,然后使用插入块的 ActiveX 属性和方法操作可见性状态动态块引用,具体来说,使用 getdynamicblockproperties 方法。


如果不需要插入块的视觉预览...

...那么你可以完全放弃INSERT命令,并使用目标容器对象(modelspace/paperspace/block定义)的insertblock方法,这将return 块引用 vla 对象。

这是一个演示如何使用 insertblock 方法的基本示例:

(defun c:test ( / dwg ins )
    (if
        (and
            (setq dwg (getfiled "Select Block" "" "dwg" 16))
            (setq ins (getpoint "\nSpecify insertion point: "))
        )
        (vla-insertblock
            (vlax-get-property
                (vla-get-activedocument (vlax-get-acad-object))
                (if (= 1 (getvar 'cvport))
                    'paperspace
                    'modelspace
                )
            )
            (vlax-3D-point (trans ins 1 0))
            dwg
            1.0 1.0 1.0 0.0
        )
    )
    (princ)
)
(vl-load-com) (princ)

此方法将 return 块引用 vla 对象,然后您可以使用 return 通过 getdynamicblockproperties 方法编辑的动态块属性数组来操作其动态块属性。

由于您特别希望修改可见性状态,因此您可能希望考虑我开发的以下一组函数作为我 dynamic block library 的一部分来修改提供的块引用的可见性状态对象:

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

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

您可以通过以下方式调用我之前提供的示例中的上述函数(当然,更改可见状态的名称以适合您的块):

(defun c:test ( / dwg ins )
    (if
        (and
            (setq dwg (getfiled "Select Block" "" "dwg" 16))
            (setq ins (getpoint "\nSpecify insertion point: "))
        )
        (LM:SetVisibilityState
            (vla-insertblock
                (vlax-get-property
                    (vla-get-activedocument (vlax-get-acad-object))
                    (if (= 1 (getvar 'cvport))
                        'paperspace
                        'modelspace
                    )
                )
                (vlax-3D-point (trans ins 1 0))
                dwg
                1.0 1.0 1.0 0.0
            )
            "YourVisibilityState"
        )
    )
    (princ)
)
(vl-load-com) (princ)

如果需要插入块的视觉预览...

...然后除了使用 grread 循环滚动您自己版本的标准 INSERT 命令(这还需要模仿所有绘图辅助工具,例如 Object Snap, and Orthomode ),您需要使用 INSERT 命令。

但是,由于块的可见性状态只能在插入块引用后更改,因此显示给用户的视觉预览将不准确。

为了两全其美,我之前提出了以下可能的解决方案(连同已发布的附带功能 here):

;; Example demonstrating a method to insert a Dynamic Block with a Visibility State already set.
;; Lee Mac  -  2013-12-24

(defun c:test ( / *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)

我的解决方案主要涉及临时插入块引用、适当配置可见性状态、创建包含配置的动态块的临时块定义,然后利用标准 INSERT 命令提供的视觉预览来插入临时块参考,然后从绘图中分解和清除。