【悬赏】提取图框中标记为[图号]的属性值修改当前布局名称

头大无恼

【问题】
为了使用图纸集或者批量发布的功能，布局命名必须做到规范，经常需要复制属性值而后修改布局名称，基本需要双击属性，复制，右键修改布局名称，再黏贴六次点击,上千张图纸就是几千个动作，而且经常会遗漏，希望高手帮助，谢谢！

见附件图框文件

希望实现功能：
1.输入bj则以图框中标记为【图号】的属性值修改当前布局名称，如果当前为模型空间则提示错误
2.输入th则将当前布局名称替换图框中标记为【图号】的属性值（为上面命令的逆操作）

【另】如果能做到在模型空间输入命令则自动把所有布局中图框中这个属性跟布局匹配则另加10个币赏金，当然会强制每个布局只有一个图框文件
图框文件的图块名称为A1_Tileblock或AX_Tileblock...

vectra

1. ;;;(get-att-textstrings (vlax-ename->vla-object (car (entsel))) '("图号" "图名文字1"))
   
2. (defun get-att-textstrings (obj names / rt tag)
   
3.   (foreach att (vlax-safearray->list
   
4.                  (vlax-variant-value (vla-getattributes obj))
   
5.                )
   
6.     (setq tag (vla-get-tagstring att))
   
7.     (if        (member tag names)
   
8.       (setq rt (cons (cons tag (vla-get-textstring att)) rt))
   
9.     )
   
10.   )
    
11.   (reverse rt)
    
12. )
    
13. 
    
14. ;;;(put-att-textstrings (vlax-ename->vla-object (car (entsel))) '(("图号" . "ABC")))
    
15. (defun put-att-textstrings (obj values / text)
    
16.   (foreach att (vlax-safearray->list
    
17.                  (vlax-variant-value (vla-getattributes obj))
    
18.                )
    
19.     (if        (setq text (cdr (assoc (vla-get-tagstring att) values)))
    
20.       (vla-put-textstring att text)
    
21.     )
    
22.   )
    
23. )
    
24. ;; 以图框中标记为“图号”的属性值修改当前布局名称
    
25. (defun c:th (/ name obj ss)
    
26.   (if (= "Model" (getvar "CTAB"))
    
27.     (princ "无法在模型空间中使用该命令。")
    
28.     (if        (setq ss (ssget        "X"
    
29.                         (list '(0 . "INSERT")
    
30.                               '(2 . "A*_Tileblock")
    
31.                               (cons 410 (getvar "CTAB"))
    
32.                         )
    
33.                  )
    
34.         )
    
35.       (progn
    
36.         (setq obj  (vlax-ename->vla-object (ssname ss 0))
    
37.               name (cdr (assoc "图号" (get-att-textstrings obj '("图号"))))
    
38.         )
    
39. 
    
40.         (command "_.LAYOUT" "R" "" name)
    
41.       )
    
42.     )
    
43.   )
    
44.   (princ)
    
45. )
    
46. 
    
47. 
    
48. ;; 当前布局名称替换图框中标记为“图号”的属性值
    
49. (defun c:bj (/ obj ss)
    
50.   (if (= "Model" (getvar "CTAB"))
    
51.     (princ "无法在模型空间中使用该命令。")
    
52.     (if        (setq ss (ssget        "X"
    
53.                         (list '(0 . "INSERT")
    
54.                               '(2 . "A*_Tileblock")
    
55.                               (cons 410 (getvar "CTAB"))
    
56.                         )
    
57.                  )
    
58.         )
    
59.       (progn
    
60.         (setq obj (vlax-ename->vla-object (ssname ss 0)))
    
61.         (put-att-textstrings obj (list (cons "图号" (getvar "CTAB"))))
    
62.       )
    
63.     )
    
64.   )
    
65. 
    
66.   (princ)
    
67. )
    

;;;(get-att-textstrings (vlax-ename->vla-object (car (entsel))) '("图号" "图名文字1"))<br /> (defun get-att-textstrings (obj names / rt tag)<br />   (foreach att (vlax-safearray->list<br />                  (vlax-variant-value (vla-getattributes obj))<br />                )<br />     (setq tag (vla-get-tagstring att))<br />     (if        (member tag names)<br />       (setq rt (cons (cons tag (vla-get-textstring att)) rt))<br />     )<br />   )<br />   (reverse rt)<br /> )<br /> <br /> ;;;(put-att-textstrings (vlax-ename->vla-object (car (entsel))) '(("图号" . "ABC")))<br /> (defun put-att-textstrings (obj values / text)<br />   (foreach att (vlax-safearray->list<br />                  (vlax-variant-value (vla-getattributes obj))<br />                )<br />     (if        (setq text (cdr (assoc (vla-get-tagstring att) values)))<br />       (vla-put-textstring att text)<br />     )<br />   )<br /> )<br /> ;; 以图框中标记为“图号”的属性值修改当前布局名称<br /> (defun c:th (/ name obj ss)<br />   (if (= "Model" (getvar "CTAB"))<br />     (princ "无法在模型空间中使用该命令。")<br />     (if        (setq ss (ssget        "X"<br />                         (list '(0 . "INSERT")<br />                               '(2 . "A*_Tileblock")<br />                               (cons 410 (getvar "CTAB"))<br />                         )<br />                  )<br />         )<br />       (progn<br />         (setq obj  (vlax-ename->vla-object (ssname ss 0))<br />               name (cdr (assoc "图号" (get-att-textstrings obj '("图号"))))<br />         )<br /> <br />         (command "_.LAYOUT" "R" "" name)<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> <br /> ;; 当前布局名称替换图框中标记为“图号”的属性值<br /> (defun c:bj (/ obj ss)<br />   (if (= "Model" (getvar "CTAB"))<br />     (princ "无法在模型空间中使用该命令。")<br />     (if        (setq ss (ssget        "X"<br />                         (list '(0 . "INSERT")<br />                               '(2 . "A*_Tileblock")<br />                               (cons 410 (getvar "CTAB"))<br />                         )<br />                  )<br />         )<br />       (progn<br />         (setq obj (vlax-ename->vla-object (ssname ss 0)))<br />         (put-att-textstrings obj (list (cons "图号" (getvar "CTAB"))))<br />       )<br />     )<br />   )<br /> <br />   (princ)<br /> )<br />

每个布局里必须要放且只能有一个图框。欢迎测试反馈BUG。

头大无恼

vectra 发表于 2017-9-27 14:58
每个布局里必须要放且只能有一个图框。欢迎测试反馈BUG。
更新增加批量替换batchth、 batchbj两命令。 ...

测试很不错，超级赞。

头大无恼

另外请您点选我回答，我才能选已解决转币给您

vectra

1. ;;;(get-att-textstrings (vlax-ename->vla-object (car (entsel))) '("图号" "图名文字1"))
   
2. (defun get-att-textstrings (obj names / rt tag)
   
3.   (foreach att (vlax-safearray->list
   
4.                  (vlax-variant-value (vla-getattributes obj))
   
5.                )
   
6.     (setq tag (vla-get-tagstring att))
   
7.     (if        (member tag names)
   
8.       (setq rt (cons (cons tag (vla-get-textstring att)) rt))
   
9.     )
   
10.   )
    
11.   (reverse rt)
    
12. )
    
13. 
    
14. ;;;(put-att-textstrings (vlax-ename->vla-object (car (entsel))) '(("图号" . "ABC")))
    
15. (defun put-att-textstrings (obj values / text)
    
16.   (foreach att (vlax-safearray->list
    
17.                  (vlax-variant-value (vla-getattributes obj))
    
18.                )
    
19.     (if        (setq text (cdr (assoc (vla-get-tagstring att) values)))
    
20.       (vla-put-textstring att text)
    
21.     )
    
22.   )
    
23. )
    
24. ;; 以图框中标记为“图号”的属性值修改当前布局名称
    
25. (defun c:th (/ name obj ss)
    
26.   (if (= "Model" (getvar "CTAB"))
    
27.     (princ "无法在模型空间中使用该命令。")
    
28.     (if        (setq ss (ssget        "X"
    
29.                         (list '(0 . "INSERT")
    
30.                               '(2 . "A*_Tileblock")
    
31.                               (cons 410 (getvar "CTAB"))
    
32.                         )
    
33.                  )
    
34.         )
    
35.       (progn
    
36.         (setq obj  (vlax-ename->vla-object (ssname ss 0))
    
37.               name (cdr (assoc "图号" (get-att-textstrings obj '("图号"))))
    
38.         )
    
39. 
    
40.         (command "_.LAYOUT" "R" "" name)
    
41.       )
    
42.     )
    
43.   )
    
44.   (princ)
    
45. )
    
46. 
    
47. 
    
48. ;; 当前布局名称替换图框中标记为“图号”的属性值
    
49. (defun c:bj (/ obj ss)
    
50.   (if (= "Model" (getvar "CTAB"))
    
51.     (princ "无法在模型空间中使用该命令。")
    
52.     (if        (setq ss (ssget        "X"
    
53.                         (list '(0 . "INSERT")
    
54.                               '(2 . "A*_Tileblock")
    
55.                               (cons 410 (getvar "CTAB"))
    
56.                         )
    
57.                  )
    
58.         )
    
59.       (progn
    
60.         (setq obj (vlax-ename->vla-object (ssname ss 0)))
    
61.         (put-att-textstrings obj (list (cons "图号" (getvar "CTAB"))))
    
62.       )
    
63.     )
    
64.   )
    
65. 
    
66.   (princ)
    
67. )
    
68. 
    
69. 
    
70. (defun c:batchbj (/ lname obj ss)
    
71. 
    
72.   (vlax-for layout (vla-get-layouts
    
73.                      (vla-get-activedocument (vlax-get-acad-object))
    
74.                    )
    
75.     (setq lname (vla-get-name layout))
    
76.     (if        (and
    
77.           (not (= :vlax-true (vla-get-modeltype layout)))
    
78.           (setq        ss (ssget "X"
    
79.                           (list        '(0 . "INSERT")
    
80.                                 '(2 . "A*_Tileblock")
    
81.                                 (cons 410 lname)
    
82.                           )
    
83.                    )
    
84.           )
    
85.         )
    
86.       (progn
    
87.         (setq obj (vlax-ename->vla-object (ssname ss 0)))
    
88.         (put-att-textstrings obj (list (cons "图号" lname)))
    
89.       )
    
90.     )
    
91.   )
    
92.   (princ)
    
93. )
    
94. 
    
95. (defun c:batchth (/ lname name obj ss)
    
96. 
    
97.   (vlax-for layout (vla-get-layouts
    
98.                      (vla-get-activedocument (vlax-get-acad-object))
    
99.                    )
    
100.     (setq lname (vla-get-name layout))
     
101.     (if        (and
     
102.           (not (= :vlax-true (vla-get-modeltype layout)))
     
103.           (setq        ss (ssget "X"
     
104.                           (list        '(0 . "INSERT")
     
105.                                 '(2 . "A*_Tileblock")
     
106.                                 (cons 410 lname)
     
107.                           )
     
108.                    )
     
109.           )
     
110.         )
     
111.       (progn
     
112.         (setq obj  (vlax-ename->vla-object (ssname ss 0))
     
113.               name (cdr (assoc "图号" (get-att-textstrings obj '("图号"))))
     
114.         )
     
115. 
     
116.         (setq er (vl-catch-all-apply 'vla-put-name (list layout name)))
     
117.         (if (vl-catch-all-error-p er)
     
118.           (princ (strcat (vl-catch-all-error-message er) " \"" name "\"")
     
119.           )
     
120.         )
     
121.       )
     
122.     )
     
123.   )
     
124.   (princ)
     
125. )

;;;(get-att-textstrings (vlax-ename->vla-object (car (entsel))) '("图号" "图名文字1"))<br /> (defun get-att-textstrings (obj names / rt tag)<br />   (foreach att (vlax-safearray->list<br />                  (vlax-variant-value (vla-getattributes obj))<br />                )<br />     (setq tag (vla-get-tagstring att))<br />     (if        (member tag names)<br />       (setq rt (cons (cons tag (vla-get-textstring att)) rt))<br />     )<br />   )<br />   (reverse rt)<br /> )<br /> <br /> ;;;(put-att-textstrings (vlax-ename->vla-object (car (entsel))) '(("图号" . "ABC")))<br /> (defun put-att-textstrings (obj values / text)<br />   (foreach att (vlax-safearray->list<br />                  (vlax-variant-value (vla-getattributes obj))<br />                )<br />     (if        (setq text (cdr (assoc (vla-get-tagstring att) values)))<br />       (vla-put-textstring att text)<br />     )<br />   )<br /> )<br /> ;; 以图框中标记为“图号”的属性值修改当前布局名称<br /> (defun c:th (/ name obj ss)<br />   (if (= "Model" (getvar "CTAB"))<br />     (princ "无法在模型空间中使用该命令。")<br />     (if        (setq ss (ssget        "X"<br />                         (list '(0 . "INSERT")<br />                               '(2 . "A*_Tileblock")<br />                               (cons 410 (getvar "CTAB"))<br />                         )<br />                  )<br />         )<br />       (progn<br />         (setq obj  (vlax-ename->vla-object (ssname ss 0))<br />               name (cdr (assoc "图号" (get-att-textstrings obj '("图号"))))<br />         )<br /> <br />         (command "_.LAYOUT" "R" "" name)<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> <br /> ;; 当前布局名称替换图框中标记为“图号”的属性值<br /> (defun c:bj (/ obj ss)<br />   (if (= "Model" (getvar "CTAB"))<br />     (princ "无法在模型空间中使用该命令。")<br />     (if        (setq ss (ssget        "X"<br />                         (list '(0 . "INSERT")<br />                               '(2 . "A*_Tileblock")<br />                               (cons 410 (getvar "CTAB"))<br />                         )<br />                  )<br />         )<br />       (progn<br />         (setq obj (vlax-ename->vla-object (ssname ss 0)))<br />         (put-att-textstrings obj (list (cons "图号" (getvar "CTAB"))))<br />       )<br />     )<br />   )<br /> <br />   (princ)<br /> )<br /> <br /> <br /> (defun c:batchbj (/ lname obj ss)<br /> <br />   (vlax-for layout (vla-get-layouts<br />                      (vla-get-activedocument (vlax-get-acad-object))<br />                    )<br />     (setq lname (vla-get-name layout))<br />     (if        (and<br />           (not (= :vlax-true (vla-get-modeltype layout)))<br />           (setq        ss (ssget "X"<br />                           (list        '(0 . "INSERT")<br />                                 '(2 . "A*_Tileblock")<br />                                 (cons 410 lname)<br />                           )<br />                    )<br />           )<br />         )<br />       (progn<br />         (setq obj (vlax-ename->vla-object (ssname ss 0)))<br />         (put-att-textstrings obj (list (cons "图号" lname)))<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> (defun c:batchth (/ lname name obj ss)<br /> <br />   (vlax-for layout (vla-get-layouts<br />                      (vla-get-activedocument (vlax-get-acad-object))<br />                    )<br />     (setq lname (vla-get-name layout))<br />     (if        (and<br />           (not (= :vlax-true (vla-get-modeltype layout)))<br />           (setq        ss (ssget "X"<br />                           (list        '(0 . "INSERT")<br />                                 '(2 . "A*_Tileblock")<br />                                 (cons 410 lname)<br />                           )<br />                    )<br />           )<br />         )<br />       (progn<br />         (setq obj  (vlax-ename->vla-object (ssname ss 0))<br />               name (cdr (assoc "图号" (get-att-textstrings obj '("图号"))))<br />         )<br /> <br />         (setq er (vl-catch-all-apply 'vla-put-name (list layout name)))<br />         (if (vl-catch-all-error-p er)<br />           (princ (strcat (vl-catch-all-error-message er) " \"" name "\"")<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

更新增加批量替换batchth、 batchbj两命令。

头大无恼

vectra 发表于 2017-9-27 16:23
更新增加批量替换batchth、 batchbj两命令。

老大，猜测是点第一楼我悬赏下面的那个我回答

头大无恼

版主，已经解决

头大无恼

原来是选择最佳答案

Atsai

将『图号』的属性设置：右键插入功能变数 -> 系统变数 -> ctab
也可以实现楼主要的结果！
附加的档案是我用楼主的档案做成功能变数，试着把他丢到配置看看吧！
图号的内容就是跟着配置名称连动的！

kexiya123