重命名图块

duotu007

系统自带的不好用，有点繁琐，自己写了简单点的。

步行黔南

很是感谢！提供了非常有用的lisp程序！！2D画图熟练者基本都是在编辑块，这个非常便捷！

wayne_myles

duotu007 发表于 2011-9-6 16:29
;;;修改块名
(vl-load-com)
(defun c:rb (/ ent name name1 dclname tempname filen stream dcl_re dlg n ...

求大大写个 一键获取图块名 并写到系统剪切版上！！！
先谢谢了！！！！

KO你

土木燃 发表于 2018-9-12 10:37
超级好用，谢谢楼主了

动态块重命名不了

jsdtzjm

下载了，谢谢

jsdtzjm

改匿名不行。

pig520

06环境调用不成功呢？

tkgm命令未知

xiaxiang

一直想做个像rename那样的列出所有图块并修改的插件。好像又没有太大难度。

lenlenq

(vla-put-name blkobj "XX")

duotu007

;;;修改块名
(vl-load-com)
(defun c:rb (/ ent name name1 dclname tempname filen stream dcl_re dlg new obj blocks BlkNam block DOC )
  (if (and (setq ent (car (entsel "\n选择需要改名的块: ")))
           (or (eq "INSERT" (cdr (assoc 0 (entget ent)))) (alert "没有选择块!"))
      )
    (progn
      (setq name (cdr (assoc 2 (entget ent))))
      (setq dclname
        (cond  
          (
            (setq tempname (vl-filename-mktemp "re-dcl-tmp.dcl") filen (open tempname "w"))
            (foreach stream '(  
"\n"
"RENAME:dialog {\n"
"    label = \"修改块名\" ;\n"
"    :row {\n"
"        :edit_box {\n"
"            key = \"dcl_edit_name\" ;\n"
"            width = 30 ;\n"
"        }\n"
"    }\n"
"    :row {\n"
"        :button {\n"
"            key = \"btn_ok\" ;\n"
"            label = \"确认\" ;\n"
"        }\n"
"        :button {\n"
"            is_cancel = true ;\n"
"            key = \"btn_cancle\" ;\n"
"            label = \"取消\" ;\n"
"        }\n"
"    }\n"
"}\n"
              )
              (princ stream filen)
            )
            (close filen)
            tempname
          )
        )
      )
      (setq DOC (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq obj (vlax-ename->vla-object ent))
      (setq blocks (vla-get-blocks DOC))
      (setq dcl_re (load_dialog dclname))
      (if (not (new_dialog "RENAME" dcl_re)) (exit))
      (set_tile "dcl_edit_name" name)
      (mode_tile "dcl_edit_name" 2)
      (action_tile "dcl_edit_name" "(setq name1 $value)")
      (action_tile "btn_ok" "(if (=(vla-get-objectname obj) \"AcDbBlockReference\")
                               (if (tblsearch \"block\" name1)
                                 (alert (strcat \"块名: \" name1 \" 已经存在.\"))
                                 (if (not (snvalid name1))
                                   (alert (strcat \"错误的块名: \" name1))
                                   (done_dialog 1)
                                 )
                               )
                             )"
      )
      (setq dlg (start_dialog))
      (if (= dlg 1)
        (progn
          (setq BlkNam (vla-get-name obj))
          (setq block  (vla-item blocks BlkNam))
          (vla-put-name block name1)
          (if (= (substr BlkNam 1 2) "*U")
            (progn
              (princ "\n这是一个匿名块.")
              (vla-auditinfo DOC :vlax-true)
              (vla-put-name block name1)
            )
          )
          (princ (strcat "\n图块 \"" name "\" 重命名为 \"" name1 "\""))
        )
      )
      (unload_dialog dcl_re)
      (vl-file-delete dclname)
    )
  )
  (princ)
)

twsyzx

楼上这个命令不错.直接跳出来,感谢

dz-2011

最好的源码，祝节日快乐！

开心WANGQI

cad2010不知能用吗