把图内所有的块名都改为大写

wei209

把图内所有的块名都改为大写，后来发现这个功能太局限了，我想把指定的几个块名如 Gtjh Duant acfgw hhK不改请问又改怎么处理呢？

2. (DEFUN C:kdx(/ BName1 BName2 ENT I i0 BName ENT ss)
3.    (setq ss (ssget "x"(list (cons 0  "INSERT"))));
4.    (IF  (/= SS NIL)
5.     (PROGN
6.     (SETQ I -1)
7.     (setq n (if ss (sslength ss) 0))
8.     (REPEAT n            
9.            (SETQ ENT (ENTGET (SSNAME SS (SETQ I (1+ I)))))
10.            (setq BName (cdr (assoc 2 ENT)))
11.            (setq BName1 (strcase BName))
12.            (setq BName2 (strcat BName1 "d"))
13.            (command "rename" "b" BName BName2)
14.            (command "rename" "b" BName2 BName1)
15.            (ENTMOD ENT)
16.            (setq i0 (+ i 1))
17.            (print i0)
18.     )
19.    )
20.     (PRINC "\n 图形内没有块!")
21.    )
22.    (PRINC)
23. )

(DEFUN C:kdx(/ BName1 BName2 ENT I i0 BName ENT ss)    (setq ss (ssget "x"(list (cons 0  "INSERT"))));    (IF  (/= SS NIL)     (PROGN     (SETQ I -1)     (setq n (if ss (sslength ss) 0))     (REPEAT n                        (SETQ ENT (ENTGET (SSNAME SS (SETQ I (1+ I)))))            (setq BName (cdr (assoc 2 ENT)))            (setq BName1 (strcase BName))            (setq BName2 (strcat BName1 "d"))            (command "rename" "b" BName BName2)            (command "rename" "b" BName2 BName1)            (ENTMOD ENT)            (setq i0 (+ i 1))            (print i0)     )    )     (PRINC "\n 图形内没有块!")    )    (PRINC) )

龙龙仔

;;By LUCAS
(defun C:KDX (/ BLOCKS NAME)
  (setq BLOCKS (vla-get-blocks
   (vla-get-activedocument (vlax-get-acad-object))
        )
  )
  (vlax-for BLK BLOCKS
    (if (not (wcmatch (setq NAME (strcase (vla-get-name BLK)))
        "*'**,*|*,GTJH,DUANT,ACFGW,HHK"
      )
 )
      (vla-put-name BLK NAME)
    )
  )
  (princ)
)

wei209

谢谢龙龙仔,新年快乐！

toproc

龙龙仔 发表于 2007-2-16 12:49
;;By LUCAS(defun C:KDX (/ BLOCKS NAME)  (setq BLOCKS (vla-get-blocks   (vla-get- ...

这个程序有个问题，就是经常在当前图形里面会有外部参照的文件，外部参照文件没卸载的话，用这个程序会出现错误。错误提示是：“Automation 错误。 输入无效”

toproc

2. (defun C:KDX ()
   
3.   (setq        BLOCKS (vla-get-blocks
   
4.                  (vla-get-activedocument (vlax-get-acad-object))
   
5.                )
   
6.   )
   
7.   (vlax-for BLK        BLOCKS
   
8.     (if        (and (not (wcmatch (setq NAME (strcase (vla-get-name BLK)))
   
9.                            "*'**,*|*"
   
10.                   )
    
11.              )
    
12.              (/= (vla-get-IsXRef BLK) :vlax-true)
    
13.         )
    
14.       (vla-put-name BLK NAME)
    
15.     )
    
16.   )
    
17.   (princ)
    
18. )

(defun C:KDX ()<br />   (setq        BLOCKS (vla-get-blocks<br />                  (vla-get-activedocument (vlax-get-acad-object))<br />                )<br />   )<br />   (vlax-for BLK        BLOCKS<br />     (if        (and (not (wcmatch (setq NAME (strcase (vla-get-name BLK)))<br />                            "*'**,*|*"<br />                   )<br />              )<br />              (/= (vla-get-IsXRef BLK) :vlax-true)<br />         )<br />       (vla-put-name BLK NAME)<br />     )<br />   )<br />   (princ)<br /> )

代码修改了下，增加判断块是否是外部参照块。