如何使用 ObjectDBX 更改块的属性

how to change attribute of block using ObjectDBX

我需要使用 AutoLISP 更改使用 ObjectDBX 方法绘图的属性。此例程 运行 正确但不更改属性,您能否建议更改代码或任何其他方法来完成此任务? 谢谢。

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

(defun DBX_ATT_CHANGE (f)
  (vl-load-com)
  (setq cadver (substr (getvar "acadver") 1 2))
  (setq id (strcat "objectdbx.AxDbDocument." cadver))
  (setq dbx (vlax-create-object id))
  (vla-open dbx f)

  (vlax-for n_object (vla-get-modelspace dbx)
    (setq dbx_en (vlax-vla-object->ename n_object))


    (setq upc_blkobj (vlax-ename->vla-object dbx_en))



    (if (vlax-method-applicable-p upc_blkobj 'GetAttributes)

      (progn
    (setq upc_attlist

           (vlax-invoke upc_blkobj 'GetAttributes)
    )

    (foreach upc_att upc_attlist
      (progn
        (if (= (vla-get-tagstring upc_att) (strcase "P_TAG1"))
          (vlax-put-property
        upc_att
        'TextString
        "555"
          )
        )
      )
    )
      )
    )
    (vlax-release-object upc_blkobj)


  )



  (vla-saveas dbx dwgfile)
  (vlax-release-object dbx)
  (prin1)
)
(defun c:test ()
  (DBX_ATT_CHANGE
    "D:/6. R&D/Delet Group LispDBXapi/7-EU-FE-48-AC-CIOC-SA - Copy.dwg"

  )
)

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

您当前的代码中存在一些奇怪的地方:


  1. (setq dbx_en (vlax-vla-object->ename n_object))
    (setq upc_blkobj (vlax-ename->vla-object dbx_en))
    

    您正在将 vla-object n_object 转换为实体名称 dbx_en,然后将此实体名称转换回 vla-object upc_blkobj。这两行是多余的,因为您可以直接使用 n_object 变量。


  1. (= (vla-get-tagstring upc_att) (strcase "P_TAG1"))
    

    您正在使用 strcase 将文字大写字符串 P_TAG1 转换为大写,然后将这个大写字符串与可能是也可能不是大写的字符串进行比较 - 我相信这一行应该是:

    (= (strcase (vla-get-tagstring upc_att)) "P_TAG1")
    

要为您提供此任务的替代方法,您可以使用我的 ObjectDBX Wrapper 函数,它提供了一种方法来评估另一幅或一组绘图上的给定函数,而无需在AutoCAD 编辑器。

我会按照以下方式亲自编写您的代码:

(defun c:test ( )
    (LM:DBXAttChange
        "D:\6. R&D\Delet Group LispDBXapi\7-EU-FE-48-AC-CIOC-SA - Copy.dwg"
        '(("P_TAG1" . "555"))
    )
    (princ)
)       

(defun LM:DBXAttChange ( dwg lst / doc flg val )
    (if (setq doc (LM:GetDocumentObject dwg))
        (progn
            (vlax-for lyt (vla-get-layouts doc)
                (vlax-for obj (vla-get-block lyt)
                    (if (and (= "AcDbBlockReference" (vla-get-objectname obj))
                             (= :vlax-true (vla-get-hasattributes obj))
                        )
                        (foreach att (vlax-invoke obj 'getattributes)
                            (if (and (setq val (cdr (assoc (strcase (vla-get-tagstring att)) lst)))
                                     (vlax-write-enabled-p att)
                                )
                                (progn
                                    (vla-put-textstring att val)
                                    (setq flg t)
                                )
                            )
                        )
                    )
                )
            )
            (if flg (vla-saveas doc dwg))
            (vlax-release-object doc)
            flg
        )
        (prompt (strcat "\nThe drawing \"" dwg "\" was not found or could not be accessed."))
    )
)

;; Get Document Object  -  Lee Mac
;; Retrieves the VLA Document Object for the supplied filename.
;; The Document Object may be present in the Documents collection, or obtained through ObjectDBX.
;; It is the callers responsibility to release such object.

(defun LM:GetDocumentObject ( dwg / app dbx dwl err vrs )
    (cond
        (   (not (setq dwg (findfile dwg))) nil)
        (   (cdr
                (assoc (strcase dwg)
                    (vlax-for doc (vla-get-documents (setq app (vlax-get-acad-object)))
                        (setq dwl (cons (cons (strcase (vla-get-fullname doc)) doc) dwl))
                    )
                )
            )
        )
        (   (progn
                (setq dbx
                    (vl-catch-all-apply 'vla-getinterfaceobject
                        (list app
                            (if (< (setq vrs (atoi (getvar 'acadver))) 16)
                                "objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs))
                            )
                        )
                    )
                )
                (or (null dbx) (vl-catch-all-error-p dbx))
            )
            (prompt "\nUnable to interface with ObjectDBX.")
        )
        (   (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vla-open (list dbx dwg))))
            (prompt (strcat "\n" (vl-catch-all-error-message err)))
        )
        (   dbx   )
    )
)

(vl-load-com) (princ)