如何使用 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"
)
)
;;;;;;;;;;;;;;
您当前的代码中存在一些奇怪的地方:
(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
变量。
(= (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)
我需要使用 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"
)
)
;;;;;;;;;;;;;;
您当前的代码中存在一些奇怪的地方:
(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-objectupc_blkobj
。这两行是多余的,因为您可以直接使用n_object
变量。
(= (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)