duotu007 发表于 2010-12-28 12:09:48

重命名图块


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

步行黔南 发表于 2012-6-16 18:46:57

本帖最后由 步行黔南 于 2012-6-16 18:47 编辑

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

wayne_myles 发表于 2018-12-8 05:49:28

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-12-7 21:09:26

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

动态块重命名不了

jsdtzjm 发表于 2011-1-6 15:50:33

下载了，谢谢

jsdtzjm 发表于 2011-1-6 15:52:48

改匿名不行。

pig520 发表于 2011-9-4 07:24:31

06环境调用不成功呢？

tkgm命令未知

xiaxiang 发表于 2011-9-4 10:54:41

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

lenlenq 发表于 2011-9-5 21:59:20

(vla-put-name blkobj "XX")

duotu007 发表于 2011-9-6 16:29:13

;;;修改块名
(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 发表于 2011-9-11 21:52:08

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

dz-2011 发表于 2011-9-12 18:47:26

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

开心WANGQI 发表于 2012-3-19 17:38:00

cad2010不知能用吗
页: [1] 2 3
查看完整版本: 重命名图块