属性块属性值复制

ld_117

套图框的时候，图框是个属性框，一个一个拷太麻烦了，用deepseek生成了一个代码，蛮好用的。

1. ;;2025.8.22
   
2. ;;DeepSeek生成
   
3. ;;复制属性块的值
   
4. (defun c:BBV (/ ss_source ss_target ent_source ent_target
   
5.                           attribs_source attribs_target attdef_source
   
6.                           attdef_target tag value found)
   
7.         (vl-load-com)
   
8. ;; 选择源属性块
   
9.         (princ "\n选择源属性块: ")
   
10.         (setq ss_source (ssget ":S" '((0 . "INSERT") (66 . 1))))
    
11.         (if (not ss_source)
    
12.                 (progn
    
13.                         (princ "\n未选择源属性块或选择的对象不是属性块。")
    
14.                         (exit)
    
15.                 )
    
16.         )
    
17.         (setq ent_source (ssname ss_source 0))
    
18.         ;; 选择目标属性块
    
19.         (princ "\n选择目标属性块: ")
    
20.         (setq ss_target (ssget ":S" '((0 . "INSERT") (66 . 1))))
    
21.         (if (not ss_target)
    
22.                 (progn
    
23.                         (princ "\n未选择目标属性块或选择的对象不是属性块。")
    
24.                         (exit)
    
25.                 )
    
26.         )
    
27.         (setq ent_target (ssname ss_target 0))
    
28.         ;; 获取源属性块的属性
    
29.         (setq attribs_source (vlax-invoke (vlax-ename->vla-object ent_source) 'GetAttributes))
    
30.         ;; 获取目标属性块的属性
    
31.         (setq attribs_target (vlax-invoke (vlax-ename->vla-object ent_target) 'GetAttributes))
    
32.         ;; 遍历源属性块的所有属性
    
33.         (foreach att attribs_source
    
34.                 (setq tag (vla-get-TagString att)
    
35.                         value (vla-get-TextString att)
    
36.                         found nil)
    
37.                 ;; 在目标属性块中查找相同标签的属性
    
38.                 (foreach target_att attribs_target
    
39.                         (if (= tag (vla-get-TagString target_att))
    
40.                                 (progn
    
41.                                         (vla-put-TextString target_att value)
    
42.                                         (setq found T)
    
43.                                 )
    
44.                         )
    
45.                 )
    
46.                 (if (not found)
    
47.                         (princ (strcat "\n警告: 目标块中未找到属性 '" tag "'"))
    
48.                 )
    
49.         )
    
50.         (vla-update (vlax-ename->vla-object ent_target))
    
51.         (princ "\n属性值复制完成。")
    
52.         (princ)
    
53. )
    

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