求助！RENAME加強、改块基点

sinommw

我在平时工作中，经常用到RENAME这个命令更改图块名字，但常常需要先记下要更改的图块名字，然后用RENAME命令，找到相应的块，然后赋予新的块名称，操作起来效率较低。

希望高手帮忙写个2个LISP，实现以下功能：
LISP1
1.当前有选择块对象时，可以直接输入新的名字更改；
2.当前无选择块对象时，提示选择，然后输入名字。

LISP2
1.当前有选择块对象时，可以直接输入或指定新的基点；
2.当前无选择块对象时，提示选择，输入或指定新的基点。

谢谢大家！

masterlong

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=87852
除了无预选择功能外
基本满足你的需要

sinommw

masterlong 发表于 2013-12-27 00:05
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=87852
除了无预选择功能外
基本满足你的需要

上面那个贴子的附件我下载了，但是不知道怎么用。。。

菜卷鱼

改块名字的，不记得是哪个大师写的了，自己一直在用

1. (vl-load-com)
   
2. (defun c:RN (/ ent name name1 dclname tempname filen stream dcl_re dlg new obj blocks BlkNam block DOC )
   
3.   (if (and (setq ent (car (entsel "\n选择需要改名的块: ")))
   
4.            (or (eq "INSERT" (cdr (assoc 0 (entget ent)))) (alert "没有选择块!"))
   
5.       )
   
6.     (progn
   
7.       (setq name (cdr (assoc 2 (entget ent))))
   
8.       (setq dclname
   
9.         (cond  
   
10.           (
    
11.             (setq tempname (vl-filename-mktemp "re-dcl-tmp.dcl") filen (open tempname "w"))
    
12.             (foreach stream '(  
    
13. "\n"
    
14. "RENAME:dialog {\n"
    
15. "    label = \"修改块名\" ;\n"
    
16. "    :row {\n"
    
17. "        :edit_box {\n"
    
18. "            key = \"dcl_edit_name\" ;\n"
    
19. "            width = 30 ;\n"
    
20. "        }\n"
    
21. "    }\n"
    
22. "    :row {\n"
    
23. "        :button {\n"
    
24. "            key = \"btn_ok\" ;\n"
    
25. "            label = \"确认\" ;\n"
    
26. "        }\n"
    
27. "        :button {\n"
    
28. "            is_cancel = true ;\n"
    
29. "            key = \"btn_cancle\" ;\n"
    
30. "            label = \"取消\" ;\n"
    
31. "        }\n"
    
32. "    }\n"
    
33. "}\n"
    
34.               )
    
35.               (princ stream filen)
    
36.             )
    
37.             (close filen)
    
38.             tempname
    
39.           )
    
40.         )
    
41.       )
    
42.       (setq DOC (vla-get-ActiveDocument (vlax-get-acad-object)))
    
43.       (setq obj (vlax-ename->vla-object ent))
    
44.       (setq blocks (vla-get-blocks DOC))
    
45.       (setq dcl_re (load_dialog dclname))
    
46.       (if (not (new_dialog "RENAME" dcl_re)) (exit))
    
47.       (set_tile "dcl_edit_name" name)
    
48.       (mode_tile "dcl_edit_name" 2)
    
49.       (action_tile "dcl_edit_name" "(setq name1 $value)")
    
50.       (action_tile "btn_ok" "(if (=(vla-get-objectname obj) \"AcDbBlockReference\")
    
51.                                (if (tblsearch \"block\" name1)
    
52.                                  (alert (strcat \"块名: \" name1 \" 已经存在.\"))
    
53.                                  (if (not (snvalid name1))
    
54.                                    (alert (strcat \"错误的块名: \" name1))
    
55.                                    (done_dialog 1)
    
56.                                  )
    
57.                                )
    
58.                              )"
    
59.       )
    
60.       (setq dlg (start_dialog))
    
61.       (if (= dlg 1)
    
62.         (progn
    
63.           (setq BlkNam (vla-get-name obj))
    
64.           (setq block  (vla-item blocks BlkNam))
    
65.           (vla-put-name block name1)
    
66.           (if (= (substr BlkNam 1 2) "*U")
    
67.             (progn
    
68.               (princ "\n这是一个匿名块.")
    
69.               (vla-auditinfo DOC :vlax-true)
    
70.               (vla-put-name block name1)
    
71.             )
    
72.           )
    
73.           (princ (strcat "\n图块 \"" name "\" 重命名为 \"" name1 "\""))
    
74.         )
    
75.       )
    
76.       (unload_dialog dcl_re)
    
77.       (vl-file-delete dclname)
    
78.     )
    
79.   )
    
80.   (princ)
    
81. )

(vl-load-com)<br /> (defun c:RN (/ ent name name1 dclname tempname filen stream dcl_re dlg new obj blocks BlkNam block DOC )<br />   (if (and (setq ent (car (entsel "\n选择需要改名的块: ")))<br />            (or (eq "INSERT" (cdr (assoc 0 (entget ent)))) (alert "没有选择块!"))<br />       )<br />     (progn<br />       (setq name (cdr (assoc 2 (entget ent))))<br />       (setq dclname <br />         (cond  <br />           (<br />             (setq tempname (vl-filename-mktemp "re-dcl-tmp.dcl") filen (open tempname "w"))<br />             (foreach stream '(  <br /> "\n"<br /> "RENAME:dialog {\n"<br /> "    label = \"修改块名\" ;\n"<br /> "    :row {\n"<br /> "        :edit_box {\n"<br /> "            key = \"dcl_edit_name\" ;\n"<br /> "            width = 30 ;\n"<br /> "        }\n"<br /> "    }\n"<br /> "    :row {\n"<br /> "        :button {\n"<br /> "            key = \"btn_ok\" ;\n"<br /> "            label = \"确认\" ;\n"<br /> "        }\n"<br /> "        :button {\n"<br /> "            is_cancel = true ;\n"<br /> "            key = \"btn_cancle\" ;\n"<br /> "            label = \"取消\" ;\n"<br /> "        }\n"<br /> "    }\n"<br /> "}\n"<br />               )<br />               (princ stream filen)<br />             )<br />             (close filen)<br />             tempname<br />           )<br />         )<br />       )<br />       (setq DOC (vla-get-ActiveDocument (vlax-get-acad-object)))<br />       (setq obj (vlax-ename->vla-object ent))<br />       (setq blocks (vla-get-blocks DOC))<br />       (setq dcl_re (load_dialog dclname))<br />       (if (not (new_dialog "RENAME" dcl_re)) (exit))<br />       (set_tile "dcl_edit_name" name)<br />       (mode_tile "dcl_edit_name" 2)<br />       (action_tile "dcl_edit_name" "(setq name1 $value)")<br />       (action_tile "btn_ok" "(if (=(vla-get-objectname obj) \"AcDbBlockReference\")<br />                                (if (tblsearch \"block\" name1)<br />                                  (alert (strcat \"块名: \" name1 \" 已经存在.\"))<br />                                  (if (not (snvalid name1))<br />                                    (alert (strcat \"错误的块名: \" name1))<br />                                    (done_dialog 1)<br />                                  )<br />                                )<br />                              )"<br />       )<br />       (setq dlg (start_dialog))<br />       (if (= dlg 1)<br />         (progn<br />           (setq BlkNam (vla-get-name obj))<br />           (setq block  (vla-item blocks BlkNam))<br />           (vla-put-name block name1)<br />           (if (= (substr BlkNam 1 2) "*U")<br />             (progn<br />               (princ "\n这是一个匿名块.")<br />               (vla-auditinfo DOC :vlax-true)<br />               (vla-put-name block name1)<br />             )<br />           )<br />           (princ (strcat "\n图块 \"" name "\" 重命名为 \"" name1 "\""))<br />         )<br />       )<br />       (unload_dialog dcl_re)<br />       (vl-file-delete dclname) <br />     )<br />   )<br />   (princ)<br /> )

sinommw

菜卷鱼 发表于 2013-12-27 21:10
改块名字的，不记得是哪个大师写的了，自己一直在用

感谢分享，程序非常好用，美中不足是不能预先选择，但这点无关紧要。

maiko

sinommw 发表于 2013-12-27 22:35
感谢分享，程序非常好用，美中不足是不能预先选择，但这点无关紧要。

entsel函数本身就不能先选择后操作

sinommw

已在论坛找到改基点程序。
传送门： ChangeBlockInsertionV1-3.lsp

感谢大家的帮助！

菜卷鱼

1. (if (and (setq ent (car (entsel "\n选择需要改名的块: ")))

(if (and (setq ent (car (entsel "\n选择需要改名的块: ")))

改成

1. (princ "\n选择需要改名的块: ")
   
2. (if (and (setq ent (ssname (ssget ":s" '((0 . "INSERT")) ) 0))

(princ "\n选择需要改名的块: ") <br /> (if (and (setq ent (ssname (ssget ":s" '((0 . "INSERT")) ) 0))

就可以先选择后操作了

xyp1964

能否批改及适应属性块？

sinommw

非常感谢，增加预选之后更加方便了！