【飞鸟集】一个通用的更改块名的程序！

highflybir

一个更改块名的程序.能针对匿名块！

2. 
   
3. (prompt "在命令行中输入命令: CCC!")
   
4. ;;;测试程序
   
5. (defun C:ccc (/ *APP *DOC EntNam NewNam)
   
6.   (vl-load-com)
   
7.   (setq *APP (vlax-get-acad-object))
   
8.   (setq *DOC (vla-get-activeDocument *APP))
   
9.   (if (setq EntNam (car (entsel "\n请选择块: ")))
   
10.     (if (setq NewNam (getstring "\n请输入新块名<字符规范,不要重名>: "))
    
11.       (change-block-name EntNam NewNam)
    
12.       (princ "\n你没有输入新块名!")
    
13.     )
    
14.     (princ "\n你没有选择物体!")
    
15.   )  
    
16.   (princ)
    
17. )
    
18. ;;;改块名程序
    
19. (defun change-block-name (EntNam NewNam / obj blocks BlkNam block)
    
20.   (setq obj (vlax-ename->vla-object EntNam))
    
21.   (setq blocks (vla-get-blocks *DOC))
    
22.   (if (=(vla-get-objectname obj) "AcDbBlockReference")
    
23.     (if (tblsearch "block" NewNam)
    
24.       (princ "\n和已有块名重复!")
    
25.       (progn
    
26.         (setq BlkNam (vla-get-name obj))
    
27.         (setq block  (vla-item blocks BlkNam))
    
28.         (vla-put-name block NewNam)
    
29.         (if (= (substr BlkNam 1 2) "*U")
    
30.           (progn
    
31.             (princ "\n这是一个匿名块.")
    
32.             (vla-auditinfo *Doc :vlax-true)
    
33.             (vla-put-name block NewNam)
    
34.           )
    
35.         )
    
36.         (princ "\n块名已经更改成"")
    
37.         (princ NewNam)
    
38.         (princ """)
    
39.       )
    
40.     )
    
41.     (princ "\n所选物体不是块!")
    
42.   )
    
43. )
    

<br /> (prompt "在命令行中输入命令: CCC!")<br /> ;;;测试程序<br /> (defun C:ccc (/ *APP *DOC EntNam NewNam)<br />   (vl-load-com)<br />   (setq *APP (vlax-get-acad-object))<br />   (setq *DOC (vla-get-activeDocument *APP))<br />   (if (setq EntNam (car (entsel "\n请选择块: ")))<br />     (if (setq NewNam (getstring "\n请输入新块名<字符规范,不要重名>: "))<br />       (change-block-name EntNam NewNam)<br />       (princ "\n你没有输入新块名!")<br />     )<br />     (princ "\n你没有选择物体!") <br />   )  <br />   (princ)<br /> )<br /> ;;;改块名程序<br /> (defun change-block-name (EntNam NewNam / obj blocks BlkNam block)<br />   (setq obj (vlax-ename->vla-object EntNam))<br />   (setq blocks (vla-get-blocks *DOC)) <br />   (if (=(vla-get-objectname obj) "AcDbBlockReference")<br />     (if (tblsearch "block" NewNam)<br />       (princ "\n和已有块名重复!")<br />       (progn<br />         (setq BlkNam (vla-get-name obj))<br />         (setq block  (vla-item blocks BlkNam))<br />         (vla-put-name block NewNam)<br />         (if (= (substr BlkNam 1 2) "*U")<br />           (progn <br />             (princ "\n这是一个匿名块.")<br />             (vla-auditinfo *Doc :vlax-true)<br />             (vla-put-name block NewNam)<br />           )<br />         )<br />         (princ "\n块名已经更改成"")<br />         (princ NewNam)<br />         (princ """)<br />       )<br />     )<br />     (princ "\n所选物体不是块!")<br />   )<br /> )<br />

orange_uo1be

zheng209 发表于 2014-7-10 21:53
一个块复制几个，改其中一个的块名，其它的也会跟着改，有什么办公不让其它的也改呢

复制块到一个新文件，修改块名后再复制回去即可

Nico

zheng209 发表于 2014-7-10 21:53
一个块复制几个，改其中一个的块名，其它的也会跟着改，有什么办公不让其它的也改呢

炸开  再重组成块

GILES.LEI

动作块改名不还没完善，只是生成一个普通块改名，原来的动作块还在，而且没有改得名字

Ea

命令: -rename 输入要重命名的对象类型
[块(B)/标注样式(D)/图层(LA)/线型(LT)/材质(M)/样式(S)/表格样式(T)/UCS(U)/视图(VI)/视口(VP)]: b

输入旧块名: 1

输入旧块名: *取消*

highflybir

To Ea:

  谢谢Ea！并非我不知道有个rename命令，我这个程序是与rename不同的。

  它可以改无名块的块名，可以不用对话框而直接选择改块名，比用rename方便。

  关于对匿名块的具体讨论，可以参见：

http://www.mjtd.com/BBS/dispbbs.asp?boardid=3&replyid=94752&id=9545&page=1&skin=0&Star=2

http://www.xdcad.net/forum/showthread.php?s=&threadid=519029&perpage=15&display=&pagenumber=1

http://www.xdcad.net/forum/showthread.php?s=&threadid=143804&perpage=15&display=&pagenumber=1

chamous

加载后输入CCC,显示"未知命令",是我的CAD安装有问题吗,还请楼主给予解答一下,小弟在此谢谢!

qly007

刚才下载试用了，相当的不错，我是刚开始学习AutoLisp的，想用楼主的来分析做为学习的样本。谢谢你！

tcsl9621

我也编过这种程序，只是我只将块名加后缀使其与其它图中的块不重名。

longer1000

tcsl9621 发表于 2007-2-14 23:25
我也编过这种程序，只是我只将块名加后缀使其与其它图中的块不重名。

麻烦兄弟将图块加后缀的程序传我一份，邮箱longer1000@sina.com

谢谢

还是永不在线吧

这个程序号，找了好久了，一堆的随机名字的块终于有救了

tester005

不错 不错  很不错

zheng209

一个块复制几个，改其中一个的块名，其它的也会跟着改，有什么办公不让其它的也改呢