【组装工】图块改名
本帖最后由 tigcat 于 2021-7-11 22:01 编辑都是前辈的程序，拿来组装一下。分享给大家，可能有点用。
;图块改名核心程序来自Highflybird
;dcl2lsp来自zml84
;程序仅作为学习交流使用，感谢各位明经前辈，各著作权归原作者所有，仅进行组装
;202107112147修改，感谢各位。
(prompt "在命令行中输入命令: tt4!")
(defun dcl_kk ()
(setqdcl_id
(load_dialog
(d1dcl)
)
)
(new_dialog "kk" dcl_id) ;启动dia5a 对话框
(set_tile "blkname" (cdr (assoc 2 (entget entnam))))
(action_tile "accept" "(ok_kk)(done_dialog 1)")
(mode_tile "blkname" 2)
(start_dialog)
)
(defun ok_kk ()
(setq blkname (get_tile "blkname"))
)
(defun C:tt4 (/ *APP *DOC EntNam NewNam blkname)
(vl-load-com)
(setq *APP (vlax-get-acad-object))
(setq *DOC (vla-get-activeDocument *APP))
(if (setq EntNam (car (entsel "\n请选择块: ")))
(if(dcl_kk)
(progn
(setq newnam blkname)
(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)
(alert "\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所选物体不是块!")
)
)
(defun d1dcl (/ lst_str str file f)
(setqlst_str'("kk:dialog{\t//dia5a为dialog name"
"label=\"修改图块名称\";//此对话框的总表头"
":edit_box{\t//编辑框1"
"label=\"输入块的新名称\";\t//编辑框提示标签"
"key=\"blkname\";\t//key值=>DCL对象名称"
"edit_width=46;\t//编辑框输入区宽度"
"}"
""
"ok_cancel;\t//确定与取消组合按钮"
"}\t//退出定义 dia5a"
""
)
)
(setq file (vl-filename-mktemp "DclTemp.dcl"))
(setq f (open file "w"))
(foreach str lst_str
(princ "\n" f)
(princ str f)
)
(close f)
;;返回
file
)
(prompt "\n*********<c:tt4>**********")
(princ)
谢谢分享，下载备用 大师呀，膜拜了。 谢谢楼主分享。 我都是搬运大师程序 谢谢楼主分享, 先收藏 谢谢分享, 学习了 比系统自带的方便多了，自带的还得记住名字 謝謝分享，下載備用 下载备用，谢谢分享
页:
[1]
2