【组装工】图块改名

tigcat

都是前辈的程序，拿来组装一下。分享给大家，可能有点用。

2.           ;图块改名核心程序来自Highflybird
   
3.           ;dcl2lsp来自zml84
   
4.           ;程序仅作为学习交流使用，感谢各位明经前辈，各著作权归原作者所有，仅进行组装
   
5.           ;202107112147修改，感谢各位。
   
6. 
   
7. (prompt "在命令行中输入命令: tt4!")
   
8. (defun dcl_kk ()
   
9.   (setq  dcl_id
   
10.    (load_dialog
    
11.      (d1dcl)
    
12.    )
    
13.   )
    
14.   (new_dialog "kk" dcl_id)    ;启动dia5a 对话框
    
15. 
    
16.   (set_tile "blkname" (cdr (assoc 2 (entget entnam))))
    
17.         
    
18.   (action_tile "accept" "(ok_kk)(done_dialog 1)")
    
19.   (mode_tile "blkname" 2)
    
20.   (start_dialog)
    
21. )
    
22. (defun ok_kk ()
    
23.   (setq blkname (get_tile "blkname"))
    
24. 
    
25. )
    
26. 
    
27. 
    
28. (defun C:tt4 (/ *APP *DOC EntNam NewNam blkname)
    
29.   (vl-load-com)
    
30.   (setq *APP (vlax-get-acad-object))
    
31.   (setq *DOC (vla-get-activeDocument *APP))
    
32. 
    
33.   (if (setq EntNam (car (entsel "\n请选择块: ")))
    
34.     (if  (dcl_kk)
    
35.       (progn
    
36.   (setq newnam blkname)
    
37.   (change-block-name EntNam NewNam)
    
38.       )
    
39.       (princ "\n你没有输入新块名!")
    
40.     )
    
41.     (princ "\n你没有选择实体!")
    
42.   )
    
43.   (princ)
    
44. )
    
45. ;;;改块名程序  
    
46. (defun change-block-name (EntNam NewNam / obj blocks BlkNam block)
    
47.   (setq obj (vlax-ename->vla-object EntNam))
    
48.   (setq blocks (vla-get-blocks *DOC))
    
49.   (if (= (vla-get-objectname obj) "AcDbBlockReference")
    
50.     (if  (tblsearch "block" NewNam)
    
51.       (alert "\n和已有块名重复!")
    
52.       (progn
    
53.   (setq BlkNam (vla-get-name obj))
    
54.   (setq block (vla-item blocks BlkNam))
    
55.   (vla-put-name block NewNam)
    
56.   (if (= (substr BlkNam 1 2) "*U")
    
57.     (progn
    
58.       (princ "\n这是一个匿名块.")
    
59.       (vla-auditinfo *Doc :vlax-true)
    
60.       (vla-put-name block NewNam)
    
61.     )
    
62.   )
    
63.   (princ "\n块名已经更改成"")
    
64.   (princ NewNam)
    
65.   (princ """)
    
66.       )
    
67.     )
    
68.     (princ "\n所选物体不是块!")
    
69.   )
    
70. )
    
71. 
    
72. (defun d1dcl (/ lst_str str file f)
    
73.   (setq  lst_str  '("kk:dialog{\t//dia5a为dialog name"
    
74.       "label="修改图块名称";//此对话框的总表头"
    
75.       ":edit_box{\t//编辑框1"
    
76.       "label="输入块的新名称";\t//编辑框提示标签"
    
77.       "key="blkname";\t//key值=>DCL对象名称"
    
78.       "edit_width=46;\t//编辑框输入区宽度"
    
79.       "}"
    
80.       ""
    
81.       "ok_cancel;\t//确定与取消组合按钮"
    
82.       "}\t//退出定义 dia5a"
    
83.       ""
    
84.      )
    
85.   )
    
86.   (setq file (vl-filename-mktemp "DclTemp.dcl"))
    
87.   (setq f (open file "w"))
    
88.   (foreach str lst_str
    
89.     (princ "\n" f)
    
90.     (princ str f)
    
91.   )
    
92.   (close f)
    
93.   ;;返回
    
94.   file
    
95. )
    
96. (prompt "\n*********<c:tt4>**********")
    
97. (princ)
    
98. 
    

          ;图块改名核心程序来自Highflybird<br />           ;dcl2lsp来自zml84<br />           ;程序仅作为学习交流使用，感谢各位明经前辈，各著作权归原作者所有，仅进行组装<br />           ;202107112147修改，感谢各位。<br /> <br /> (prompt "在命令行中输入命令: tt4!")<br /> (defun dcl_kk ()<br />   (setq  dcl_id<br />    (load_dialog<br />      (d1dcl)<br />    )<br />   )<br />   (new_dialog "kk" dcl_id)    ;启动dia5a 对话框 <br /> <br />   (set_tile "blkname" (cdr (assoc 2 (entget entnam))))<br />         <br />   (action_tile "accept" "(ok_kk)(done_dialog 1)")<br />   (mode_tile "blkname" 2)<br />   (start_dialog)<br /> )<br /> (defun ok_kk ()<br />   (setq blkname (get_tile "blkname"))<br /> <br /> )<br /> <br /> <br /> (defun C:tt4 (/ *APP *DOC EntNam NewNam blkname)<br />   (vl-load-com)<br />   (setq *APP (vlax-get-acad-object))<br />   (setq *DOC (vla-get-activeDocument *APP))<br /> <br />   (if (setq EntNam (car (entsel "\n请选择块: ")))<br />     (if  (dcl_kk)<br />       (progn<br />   (setq newnam blkname)<br />   (change-block-name EntNam NewNam)<br />       )<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 />       (alert "\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 /> <br /> (defun d1dcl (/ lst_str str file f)<br />   (setq  lst_str  '("kk:dialog{\t//dia5a为dialog name"<br />       "label="修改图块名称";//此对话框的总表头"<br />       ":edit_box{\t//编辑框1"<br />       "label="输入块的新名称";\t//编辑框提示标签"<br />       "key="blkname";\t//key值=>DCL对象名称"<br />       "edit_width=46;\t//编辑框输入区宽度"<br />       "}"<br />       ""<br />       "ok_cancel;\t//确定与取消组合按钮"<br />       "}\t//退出定义 dia5a"<br />       ""<br />      )<br />   )<br />   (setq file (vl-filename-mktemp "DclTemp.dcl"))<br />   (setq f (open file "w"))<br />   (foreach str lst_str<br />     (princ "\n" f)<br />     (princ str f)<br />   )<br />   (close f)<br />   ;;返回<br />   file<br /> )<br /> (prompt "\n*********<c:tt4>**********")<br /> (princ)<br /> <br />

sunny_8848

谢谢分享，下载备用

mokson

大师呀，膜拜了。

panliang9

谢谢楼主分享。

tigcat

我都是搬运大师程序

juliana207

谢谢楼主分享, 先收藏

juliana207

谢谢分享, 学习了

zhoupeng220

比系统自带的方便多了，自带的还得记住名字

白色微風1991

謝謝分享，下載備用

xxyyzzlg

下载备用，谢谢分享