属性块属性值复制
套图框的时候，图框是个属性框，一个一个拷太麻烦了，用deepseek生成了一个代码，蛮好用的。;;2025.8.22
;;DeepSeek生成
;;复制属性块的值
(defun c:BBV (/ ss_source ss_target ent_source ent_target
attribs_source attribs_target attdef_source
attdef_target tag value found)
(vl-load-com)
;; 选择源属性块
(princ "\n选择源属性块: ")
(setq ss_source (ssget ":S" '((0 . "INSERT") (66 . 1))))
(if (not ss_source)
(progn
(princ "\n未选择源属性块或选择的对象不是属性块。")
(exit)
)
)
(setq ent_source (ssname ss_source 0))
;; 选择目标属性块
(princ "\n选择目标属性块: ")
(setq ss_target (ssget ":S" '((0 . "INSERT") (66 . 1))))
(if (not ss_target)
(progn
(princ "\n未选择目标属性块或选择的对象不是属性块。")
(exit)
)
)
(setq ent_target (ssname ss_target 0))
;; 获取源属性块的属性
(setq attribs_source (vlax-invoke (vlax-ename->vla-object ent_source) 'GetAttributes))
;; 获取目标属性块的属性
(setq attribs_target (vlax-invoke (vlax-ename->vla-object ent_target) 'GetAttributes))
;; 遍历源属性块的所有属性
(foreach att attribs_source
(setq tag (vla-get-TagString att)
value (vla-get-TextString att)
found nil)
;; 在目标属性块中查找相同标签的属性
(foreach target_att attribs_target
(if (= tag (vla-get-TagString target_att))
(progn
(vla-put-TextString target_att value)
(setq found T)
)
)
)
(if (not found)
(princ (strcat "\n警告: 目标块中未找到属性 '" tag "'"))
)
)
(vla-update (vlax-ename->vla-object ent_target))
(princ "\n属性值复制完成。")
(princ)
)
页:
[1]