求rename命令增强版

weiqi

求在一个DWG图里,rename命令增加版，把图层，块名，标注样式等。。。一个命令全部加上前缀。

rhett_sky

这个我也需要

weiqi

自己解决多年~

刘炎华

产品图导入时，一直都是手动改，可以分享吗

andyding

所有通用函数来自论坛，非本人原创。搬运拼凑而成，试试看能不能用吧。

2. (defun C:renall  (/ BLOCKLST blockna DIMLST I LAYERLST M N P PRE TEXTLST)
   
3.   (command "_undo" "be")
   
4.   (setq *ACAD*  (vlax-get-acad-object)
   
5.         *DOC*   (vla-get-ActiveDocument *ACAD*)
   
6.   )
   
7.   (if (and
   
8.   (setq blocklst (MJ:blocks))
   
9.   (setq layerlst (MJ:layers))
   
10.   (setq textlst (MJ:textstyles))
    
11.   (setq dimlst (MJ:dimstyles))
    
12.       )
    
13.     (progn
    
14.       (setq i 0
    
15.       n 0
    
16.       m 0
    
17.       P 0
    
18.       )
    
19.       (setq pre (getstring "\n请输入前缀："))
    
20.       (repeat (length blocklst)
    
21.   (if (= (substr (nth i blocklst) 1 1) "*")
    
22.     (setq blockna (substr (nth i blocklst) 2))
    
23.     (setq blockna (nth i blocklst))
    
24.   )
    
25.   (MJ:RenameBlock1
    
26.     (nth i blocklst)
    
27.     (strcat pre blockna)
    
28.   )
    
29.   (setq i (1+ i))
    
30.       )
    
31.       (repeat (length layerlst)
    
32.   (if (/= (nth n layerlst) "0")
    
33.     (progn
    
34.       (MJ:Renamelayer1
    
35.         (nth n layerlst)
    
36.         (strcat pre (nth n layerlst))
    
37.       )
    
38.       (setq n (1+ n))
    
39.     )
    
40.     (setq n (1+ n))
    
41.   )
    
42.       )
    
43.       (repeat (length textlst)
    
44.   (command "_.rename"
    
45.      "s"
    
46.      (nth m textlst)
    
47.      (strcat pre (nth m textlst))
    
48.   )
    
49.   (setq m (1+ m))
    
50.       )
    
51.       (repeat (length dimlst)
    
52.   (MJ:RenameDimStyles1
    
53.     (nth p dimlst)
    
54.     (strcat pre (nth p dimlst))
    
55.   )
    
56.   (setq p (1+ p))
    
57.       )
    
58.       (vla-auditinfo
    
59.   (vla-get-activedocument (vlax-get-acad-object))
    
60.   :vlax-true
    
61.       )
    
62.     )
    
63.   )
    
64.   (command "_undo" "end")
    
65.   (princ)
    
66. )
    
67. 
    
68. ;;改块名，bn的块存在,名为nn的块不存在
    
69. ;;(MJ:RenameBlock1 "ccd1" "ccd2")
    
70. (defun MJ:RenameBlock1 (bn nn /)
    
71.   (vla-put-name (vla-item (vla-get-blocks *DOC*) bn) nn)
    
72. )
    
73. ;;改层名
    
74. (defun MJ:Renamelayer1 (bn nn /)
    
75.   (vla-put-name (vla-item (vla-get-layers *DOC*) bn) nn)
    
76. )
    
77. ;;改字体样式名
    
78. (defun MJ:RenameDimStyles1 (bn nn /)
    
79.   (vla-put-name (vla-item (vla-get-DimStyles *DOC*) bn) nn)
    
80. )
    
81. 
    
82. 
    
83. ;; 返回块名列表("*D5" "A$C263E5435" "b2" "b1")
    
84. (defun MJ:blocks (/ b bn tl)
    
85.   (vlax-for b (vla-get-blocks *DOC*)
    
86.     (if  (= (vla-get-islayout b) :vlax-false)
    
87.       (setq tl (cons (vla-get-name b) tl))
    
88.     )
    
89.   )
    
90.   (reverse tl)
    
91. )
    
92. ;; 返回层名列表
    
93. (defun MJ:layers (/ b bn tl)
    
94.   (vlax-for b (vla-get-layers *DOC*)
    
95.     (setq tl (cons (vla-get-name b) tl))
    
96.   )
    
97.   (reverse tl)
    
98. )
    
99. 
    
100. ;; 返回字体样式名列表
     
101. (defun MJ:textstyles (/ b bn tl)
     
102.   (vlax-for b (vla-get-textstyles *DOC*)
     
103.     (setq tl (cons (vla-get-name b) tl))
     
104.   )
     
105.   (reverse tl)
     
106. )
     
107. ;; 返回标注样式列表
     
108. (defun MJ:dimstyles (/ b bn tl)
     
109.   (vlax-for b (vla-get-DimStyles *DOC*)
     
110.     (setq tl (cons (vla-get-name b) tl))
     
111.   )
     
112.   (reverse tl)
     
113. )

(defun C:renall  (/ BLOCKLST blockna DIMLST I LAYERLST M N P PRE TEXTLST)<br />   (command "_undo" "be")<br />   (setq *ACAD*  (vlax-get-acad-object)<br />         *DOC*   (vla-get-ActiveDocument *ACAD*)<br />   )<br />   (if (and<br />   (setq blocklst (MJ:blocks))<br />   (setq layerlst (MJ:layers))<br />   (setq textlst (MJ:textstyles))<br />   (setq dimlst (MJ:dimstyles))<br />       )<br />     (progn<br />       (setq i 0<br />       n 0<br />       m 0<br />       P 0<br />       )<br />       (setq pre (getstring "\n请输入前缀："))<br />       (repeat (length blocklst)<br />   (if (= (substr (nth i blocklst) 1 1) "*")<br />     (setq blockna (substr (nth i blocklst) 2))<br />     (setq blockna (nth i blocklst))<br />   )<br />   (MJ:RenameBlock1<br />     (nth i blocklst)<br />     (strcat pre blockna)<br />   )<br />   (setq i (1+ i))<br />       )<br />       (repeat (length layerlst)<br />   (if (/= (nth n layerlst) "0")<br />     (progn<br />       (MJ:Renamelayer1<br />         (nth n layerlst)<br />         (strcat pre (nth n layerlst))<br />       )<br />       (setq n (1+ n))<br />     )<br />     (setq n (1+ n))<br />   )<br />       )<br />       (repeat (length textlst)<br />   (command "_.rename"<br />      "s"<br />      (nth m textlst)<br />      (strcat pre (nth m textlst))<br />   )<br />   (setq m (1+ m))<br />       )<br />       (repeat (length dimlst)<br />   (MJ:RenameDimStyles1<br />     (nth p dimlst)<br />     (strcat pre (nth p dimlst))<br />   )<br />   (setq p (1+ p))<br />       )<br />       (vla-auditinfo<br />   (vla-get-activedocument (vlax-get-acad-object))<br />   :vlax-true<br />       )<br />     )<br />   )<br />   (command "_undo" "end")<br />   (princ)<br /> )<br /> <br /> ;;改块名，bn的块存在,名为nn的块不存在<br /> ;;(MJ:RenameBlock1 "ccd1" "ccd2")<br /> (defun MJ:RenameBlock1 (bn nn /)<br />   (vla-put-name (vla-item (vla-get-blocks *DOC*) bn) nn)<br /> )<br /> ;;改层名<br /> (defun MJ:Renamelayer1 (bn nn /)<br />   (vla-put-name (vla-item (vla-get-layers *DOC*) bn) nn)<br /> )<br /> ;;改字体样式名<br /> (defun MJ:RenameDimStyles1 (bn nn /)<br />   (vla-put-name (vla-item (vla-get-DimStyles *DOC*) bn) nn)<br /> )<br /> <br /> <br /> ;; 返回块名列表("*D5" "A$C263E5435" "b2" "b1")<br /> (defun MJ:blocks (/ b bn tl)<br />   (vlax-for b (vla-get-blocks *DOC*)<br />     (if  (= (vla-get-islayout b) :vlax-false)<br />       (setq tl (cons (vla-get-name b) tl))<br />     )<br />   )<br />   (reverse tl)<br /> )<br /> ;; 返回层名列表<br /> (defun MJ:layers (/ b bn tl)<br />   (vlax-for b (vla-get-layers *DOC*)<br />     (setq tl (cons (vla-get-name b) tl))<br />   )<br />   (reverse tl)<br /> )<br /> <br /> ;; 返回字体样式名列表<br /> (defun MJ:textstyles (/ b bn tl)<br />   (vlax-for b (vla-get-textstyles *DOC*)<br />     (setq tl (cons (vla-get-name b) tl))<br />   )<br />   (reverse tl)<br /> )<br /> ;; 返回标注样式列表<br /> (defun MJ:dimstyles (/ b bn tl)<br />   (vlax-for b (vla-get-DimStyles *DOC*)<br />     (setq tl (cons (vla-get-name b) tl))<br />   )<br />   (reverse tl)<br /> )