求改某一块名

weiqi

图里有 多个块，选者对象 只改 单个块名。

有一个程序有这功能。
http://bbs.mjtd.com/thread-19105-1-1.html
27楼的回复。

搞了很久，简化不来。。。

求简化，只要选者对象 和 输入新块名。望高手出手~

pzweng

pzweng 发表于 2013-6-5 07:48
我这个功能主要不是这个的，所以写的很复杂

我把命令改成了:dkrename
因为这个程序不单是这个用途的，所以抱歉不能提供源程序,这个能算领赏吗

weiqi

用最土的方法写了一个。

(DEFUN C:TT2 ()
(print "请选择单个块")
(setq dbxz (ssget))
(setq dbzm (entget (SSNAME dbxz 0) ))
(setq dbkm (Cdr(assoc 2 dbzm )))
(setq dbkd (Cdr(assoc 10 dbzm )))
;(print (strcat "对比块名" dbkm))
(print "原基点")
(print  dbkd)
;(sssetfirst nil (ssget dbkd))
(command "EXPLODE" dbxz )
(setq xkname (getstring "请输入新块名:"))
(command "BLOCK" xkname dbkd "p" "")
(command "INSERT" xkname dbkd "" "" "")
)

pzweng

(命令:test)

自贡黄明儒

http://bbs.mjtd.com/thread-19105-1-1.html
你已经找到alin版主的程序了，为什么还要悬赏？
在alin版主提供的程序之前，我也是用土办法搞定。后来我就一直用align版主的程序了。
当年的土办法如下：

1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
2. ;更改选定部分块的名字,对相同的其它块不影响，此程序有一定的危险性，操作失败可能删除选择的块
   
3. ;只对选择集中第一个块的名字改变
   
4. (defun C:ChangeSelectBlocksName ( / ssObjects strEntityName listEntityDXF strBlockName fblockpoint bool newblockname strBlockNameT)
   
5. 
   
6. ;;;;;;;;;;;
   
7. ;;;判断有没有某个块名,返回真假
   
8. (defun BlockNameExist (BlockName / bn block_n  Bool)
   
9. (SETQ block_n (TBLNEXT "block" T))
   
10. (WHILE block_n  
    
11.    (setq bn (CDR (ASSOC '2 block_n)))
    
12.     (if (= bn BlockName) (setq Bool T))
    
13.    (SETQ block_n (TBLNEXT "block"))
    
14. )
    
15. Bool
    
16. )
    
17. ;;;;;;;;;;
    
18. 
    
19. 
    
20. (setq ssObjects (lt:ssget '("\n点选或窗选要改名的块:" ((0 . "insert") (100 . "AcDbBlockReference")))));拾取要更名的块
    
21. (setq strEntityName (ssname ssObjects 0)); strEntityName，取得第1个对象名
    
22. (setq listEntityDXF (entget strEntityName))
    
23. (setq strBlockName (cdr (assoc 2 listEntityDXF)));第1个对象块名
    
24. (setq fblockpoint (cdr (assoc 10 listEntityDXF)));第1个对象定位点
    
25. (princ (strcat "你所选择的块，其块名为:" strBlockName))
    
26. 
    
27. (setq bool T)
    
28. (while bool
    
29. (setq newblockname (getstring "\n 请输入规范的新块名:"))
    
30. (if (BlockNameExist newblockname) (princ "你输入的块名已经存在!请重新取名.........") (setq bool nil))
    
31. );end while
    
32. 
    
33. (if newblockname (progn
    
34. (command "_copybase" fblockpoint ssObjects "");带基点复制选定块
    
35. (command "_erase" ssObjects "");删除选定块
    
36. (setq strBlockNameT (strcat strBlockName "%"));暂时将选定块后缀加%
    
37. (command "_rename" "B" strBlockName strBlockNameT);将选定块以外同名块暂时更名
    
38. (command "zoom" "C" fblockpoint "")
    
39. (command "_pasteclip" fblockpoint)
    
40. (command "_rename" "B" strBlockName newblockname);选定块更名
    
41. (command "_rename" "B" strBlockNameT strBlockName);将选定块以外同名块改回原来的名字
    
42. );end progn
    
43. (exit)
    
44. );end if
    
45. 
    
46. (gc)
    
47. )
    
48. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
49. 
    
50. 
    
51. ;;_________________________________________________________________
    

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;更改选定部分块的名字,对相同的其它块不影响，此程序有一定的危险性，操作失败可能删除选择的块<br /> ;只对选择集中第一个块的名字改变<br /> (defun C:ChangeSelectBlocksName ( / ssObjects strEntityName listEntityDXF strBlockName fblockpoint bool newblockname strBlockNameT)<br /> <br /> ;;;;;;;;;;;<br /> ;;;判断有没有某个块名,返回真假<br /> (defun BlockNameExist (BlockName / bn block_n  Bool)<br /> (SETQ block_n (TBLNEXT "block" T))<br /> (WHILE block_n  <br />    (setq bn (CDR (ASSOC '2 block_n)))<br />     (if (= bn BlockName) (setq Bool T))<br />    (SETQ block_n (TBLNEXT "block"))<br /> ) <br /> Bool<br /> )<br /> ;;;;;;;;;;<br /> <br /> <br /> (setq ssObjects (lt:ssget '("\n点选或窗选要改名的块:" ((0 . "insert") (100 . "AcDbBlockReference")))));拾取要更名的块<br /> (setq strEntityName (ssname ssObjects 0)); strEntityName，取得第1个对象名<br /> (setq listEntityDXF (entget strEntityName))<br /> (setq strBlockName (cdr (assoc 2 listEntityDXF)));第1个对象块名<br /> (setq fblockpoint (cdr (assoc 10 listEntityDXF)));第1个对象定位点<br /> (princ (strcat "你所选择的块，其块名为:" strBlockName))<br /> <br /> (setq bool T)<br /> (while bool<br /> (setq newblockname (getstring "\n 请输入规范的新块名:"))<br /> (if (BlockNameExist newblockname) (princ "你输入的块名已经存在!请重新取名.........") (setq bool nil))<br /> );end while<br /> <br /> (if newblockname (progn<br /> (command "_copybase" fblockpoint ssObjects "");带基点复制选定块<br /> (command "_erase" ssObjects "");删除选定块<br /> (setq strBlockNameT (strcat strBlockName "%"));暂时将选定块后缀加%<br /> (command "_rename" "B" strBlockName strBlockNameT);将选定块以外同名块暂时更名<br /> (command "zoom" "C" fblockpoint "")<br /> (command "_pasteclip" fblockpoint)<br /> (command "_rename" "B" strBlockName newblockname);选定块更名<br /> (command "_rename" "B" strBlockNameT strBlockName);将选定块以外同名块改回原来的名字<br /> );end progn<br /> (exit)<br /> );end if<br /> <br /> (gc)<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> <br /> <br /> ;;_________________________________________________________________<br />

weiqi

upupupupupupupupupup~

weiqi

upupupupup~~~求G版来抓灌水

weiqi

求代码。。

weiqi

upupupupup

pzweng

weiqi 发表于 2013-6-3 23:13
upupupupup

我这个功能主要不是这个的，所以写的很复杂