修改块名

Lisphk

1. (defun c:bold (/ selset ent def name adoc)
   
2.   (if (and (/= "" (setq blkname (getstring "\n输入新块名<退出>:")))
   
3.            (setq selset (ssget "_+.:S:E" '((0 . "INSERT")))))
   
4.     (progn
   
5.       (setq ent  (vlax-ename->vla-object (ssname selset 0))
   
6.             name (cond ((vlax-property-available-p ent 'effectivename) (vla-get-effectivename ent))
   
7.                        ((vlax-property-available-p ent 'name) (vla-get-name ent))
   
8.                  ) ;_ end of cond
   
9.       ) ;_ end of setq
   
10.       (cond
    
11.         ((not name) (princ "\nEntity hasn't \"Name\" or \"EffectiveName\" property"))
    
12.         ((wcmatch name "`**") (princ "\nUnnamed blocks can't be renamed"))
    
13.         (t
    
14.          (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
    
15.          (if (vl-catch-all-error-p
    
16.                (setq
    
17.                  err (vl-catch-all-apply
    
18.                        (function
    
19.                          (lambda ()
    
20.                            (vla-put-name
    
21.                              (vla-item (vla-get-blocks adoc) name)
    
22.                              blkname
    
23.                            ) ;_ end of vla-put-name
    
24.                          ) ;_ end of lambda
    
25.                        ) ;_ end of function
    
26.                      ) ;_ end of vl-catch-all-apply
    
27.                ) ;_ end of setq
    
28.              ) ;_ end of vl-catch-all-error-p
    
29.            (princ (strcat "\nError : " (vl-catch-all-error-message err)))
    
30.          ) ;_ end of if
    
31.          (vla-endundomark adoc)
    
32.         )
    
33.       ) ;_ end of cond
    
34.     ) ;_ end of progn
    
35.     (princ "\nNothing selected")
    
36.   ) ;_ end of if
    
37.   (princ)
    
38. ) ;_ end of defun
    
39. 
    

(defun c:bold (/ selset ent def name adoc)<br />   (if (and (/= "" (setq blkname (getstring "\n输入新块名<退出>:")))<br />            (setq selset (ssget "_+.:S:E" '((0 . "INSERT")))))<br />     (progn<br />       (setq ent  (vlax-ename->vla-object (ssname selset 0))<br />             name (cond ((vlax-property-available-p ent 'effectivename) (vla-get-effectivename ent))<br />                        ((vlax-property-available-p ent 'name) (vla-get-name ent))<br />                  ) ;_ end of cond<br />       ) ;_ end of setq<br />       (cond<br />         ((not name) (princ "\nEntity hasn't \"Name\" or \"EffectiveName\" property"))<br />         ((wcmatch name "`**") (princ "\nUnnamed blocks can't be renamed"))<br />         (t<br />          (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))<br />          (if (vl-catch-all-error-p<br />                (setq<br />                  err (vl-catch-all-apply<br />                        (function<br />                          (lambda ()<br />                            (vla-put-name<br />                              (vla-item (vla-get-blocks adoc) name)<br />                              blkname <br />                            ) ;_ end of vla-put-name<br />                          ) ;_ end of lambda<br />                        ) ;_ end of function<br />                      ) ;_ end of vl-catch-all-apply<br />                ) ;_ end of setq<br />              ) ;_ end of vl-catch-all-error-p<br />            (princ (strcat "\nError : " (vl-catch-all-error-message err)))<br />          ) ;_ end of if<br />          (vla-endundomark adoc)<br />         )<br />       ) ;_ end of cond<br />     ) ;_ end of progn<br />     (princ "\nNothing selected")<br />   ) ;_ end of if<br />   (princ)<br /> ) ;_ end of defun<br /> <br />

chen7560152

感谢大侠分享

zxc001975cvb

感谢大侠分享！