修改块名

dcl1214

1. (defun $block-rename$ (ent oldname newname lst / blocks blk rename obj)
   
2.           ;修改块名
   
3.   (if (not oldname)
   
4.     (if  ent
   
5.       (progn
   
6.   (if (= (TYPE ent) 'ENAME)
   
7.     (SETQ OBJ (vlax-ename->vla-object ent))
   
8.   )
   
9.   (setq oldname (vl-catch-all-apply
   
10.       'vla-get-effectivename
    
11.       (list obj)
    
12.           )
    
13.   )
    
14.   (if (vl-catch-all-error-p oldname)
    
15.     (setq oldname (vl-catch-all-apply 'vla-get-name (list obj)))
    
16.   )
    
17.   (if (vl-catch-all-error-p oldname)
    
18.     (setq oldname nil)
    
19.   )
    
20.       )
    
21.     )
    
22.   )
    
23.   (if newname
    
24.     (progn
    
25.       (setq blocks (vla-get-blocks
    
26.          (vla-get-activeDocument (vlax-get-acad-object))
    
27.        )
    
28.       )
    
29.       (setq blk (vl-catch-all-apply 'vla-item (list blocks oldname)))
    
30.       (vl-catch-all-apply 'vla-put-name (list blk newname))
    
31.       (setq rename (vla-get-name blk))
    
32.       (vl-catch-all-apply 'vlax-release-object (list blocks))
    
33.       (vl-catch-all-apply 'vlax-release-object (list blK))
    
34.     )
    
35.   )
    
36.   rename        ;返回
    
37. )

(defun $block-rename$ (ent oldname newname lst / blocks blk rename obj)<br />           ;修改块名<br />   (if (not oldname)<br />     (if  ent<br />       (progn<br />   (if (= (TYPE ent) 'ENAME)<br />     (SETQ OBJ (vlax-ename->vla-object ent))<br />   )<br />   (setq oldname (vl-catch-all-apply<br />       'vla-get-effectivename<br />       (list obj)<br />           )<br />   )<br />   (if (vl-catch-all-error-p oldname)<br />     (setq oldname (vl-catch-all-apply 'vla-get-name (list obj)))<br />   )<br />   (if (vl-catch-all-error-p oldname)<br />     (setq oldname nil)<br />   )<br />       )<br />     )<br />   )<br />   (if newname<br />     (progn<br />       (setq blocks (vla-get-blocks<br />          (vla-get-activeDocument (vlax-get-acad-object))<br />        )<br />       )<br />       (setq blk (vl-catch-all-apply 'vla-item (list blocks oldname)))<br />       (vl-catch-all-apply 'vla-put-name (list blk newname))<br />       (setq rename (vla-get-name blk))<br />       (vl-catch-all-apply 'vlax-release-object (list blocks))<br />       (vl-catch-all-apply 'vlax-release-object (list blK))<br />     )<br />   )<br />   rename        ;返回<br /> )

伊江痕

学的了，很有用 我的梦想

yefei812678

谢谢分享谢谢分享谢谢分享

1028695446

多了一个参数lst？

hubeiwdlue

谢谢分享，写得好严谨的函数。

664571221

可以搞一个修改块插入点的功能吗

magicheno

感谢大佬分享

rullz

感谢大佬分享