一个通用的更改块名的程序！

Highflybird

一个更改块名的程序.能针对匿名块！
[pcode=lisp,true]
(prompt "在命令行中输入命令: CCC!")
;;;测试程序
(defun C:ccc (/ *APP *DOC EntNam NewNam)
  (vl-load-com)
  (setq *APP (vlax-get-acad-object))
  (setq *DOC (vla-get-activeDocument *APP))
  (if (setq EntNam (car (entsel "\n请选择块: ")))
    (if (setq NewNam (getstring "\n请输入新块名<字符规范,不要重名>: "))
      (change-block-name EntNam NewNam)
      (princ "\n你没有输入新块名!")
    )
    (princ "\n你没有选择物体!")
  )  
  (princ)
)
;;;改块名程序
(defun change-block-name (EntNam NewNam / obj blocks BlkNam block)
  (setq obj (vlax-ename->vla-object EntNam))
  (setq blocks (vla-get-blocks *DOC))
  (if (=(vla-get-objectname obj) "AcDbBlockReference")
    (if (tblsearch "block" NewNam)
      (princ "\n和已有块名重复!")
      (progn
        (setq BlkNam (vla-get-name obj))
        (setq block  (vla-item blocks BlkNam))
        (vla-put-name block NewNam)
        (if (= (substr BlkNam 1 2) "*U")
          (progn
            (princ "\n这是一个匿名块.")
            (vla-auditinfo *Doc :vlax-true)
            (vla-put-name block NewNam)
          )
        )
        (princ "\n块名已经更改成\"")
        (princ NewNam)
        (princ "\"")
      )
    )
    (princ "\n所选物体不是块!")
  )
)
[/pcode]