本帖最后由 tigcat 于 2021-7-11 22:01 编辑

都是前辈的程序，拿来组装一下。分享给大家，可能有点用。
  2.           ;图块改名核心程序来自Highflybird
  3.           ;dcl2lsp来自zml84
  4.           ;程序仅作为学习交流使用，感谢各位明经前辈，各著作权归原作者所有，仅进行组装
  5.           ;202107112147修改，感谢各位。

  7. (prompt "在命令行中输入命令: tt4!")
  8. (defun dcl_kk ()
  9.   (setq  dcl_id
  10.    (load_dialog
  11.      (d1dcl)
  12.    )
  13.   )
  14.   (new_dialog "kk" dcl_id)    ;启动dia5a 对话框

  16.   (set_tile "blkname" (cdr (assoc 2 (entget entnam))))
  17.         
  18.   (action_tile "accept" "(ok_kk)(done_dialog 1)")
  19.   (mode_tile "blkname" 2)
  20.   (start_dialog)
  21. )
  22. (defun ok_kk ()
  23.   (setq blkname (get_tile "blkname"))

  25. )


  28. (defun C:tt4 (/ *APP *DOC EntNam NewNam blkname)
  29.   (vl-load-com)
  30.   (setq *APP (vlax-get-acad-object))
  31.   (setq *DOC (vla-get-activeDocument *APP))

  33.   (if (setq EntNam (car (entsel "\n请选择块: ")))
  34.     (if  (dcl_kk)
  35.       (progn
  36.   (setq newnam blkname)
  37.   (change-block-name EntNam NewNam)
  38.       )
  39.       (princ "\n你没有输入新块名!")
  40.     )
  41.     (princ "\n你没有选择实体!")
  42.   )
  43.   (princ)
  44. )
  45. ;;;改块名程序  
  46. (defun change-block-name (EntNam NewNam / obj blocks BlkNam block)
  47.   (setq obj (vlax-ename->vla-object EntNam))
  48.   (setq blocks (vla-get-blocks *DOC))
  49.   (if (= (vla-get-objectname obj) "AcDbBlockReference")
  50.     (if  (tblsearch "block" NewNam)
  51.       (alert "\n和已有块名重复!")
  52.       (progn
  53.   (setq BlkNam (vla-get-name obj))
  54.   (setq block (vla-item blocks BlkNam))
  55.   (vla-put-name block NewNam)
  56.   (if (= (substr BlkNam 1 2) "*U")
  57.     (progn
  58.       (princ "\n这是一个匿名块.")
  59.       (vla-auditinfo *Doc :vlax-true)
  60.       (vla-put-name block NewNam)
  61.     )
  62.   )
  63.   (princ "\n块名已经更改成"")
  64.   (princ NewNam)
  65.   (princ """)
  66.       )
  67.     )
  68.     (princ "\n所选物体不是块!")
  69.   )
  70. )

  72. (defun d1dcl (/ lst_str str file f)
  73.   (setq  lst_str  '("kk:dialog{\t//dia5a为dialog name"
  74.       "label="修改图块名称";//此对话框的总表头"
  75.       ":edit_box{\t//编辑框1"
  76.       "label="输入块的新名称";\t//编辑框提示标签"
  77.       "key="blkname";\t//key值=>DCL对象名称"
  78.       "edit_width=46;\t//编辑框输入区宽度"
  79.       "}"
  80.       ""
  81.       "ok_cancel;\t//确定与取消组合按钮"
  82.       "}\t//退出定义 dia5a"
  83.       ""
  84.      )
  85.   )
  86.   (setq file (vl-filename-mktemp "DclTemp.dcl"))
  87.   (setq f (open file "w"))
  88.   (foreach str lst_str
  89.     (princ "\n" f)
  90.     (princ str f)
  91.   )
  92.   (close f)
  93.   ;;返回
  94.   file
  95. )
  96. (prompt "\n*********<c:tt4>**********")
  97. (princ)





网友答:
26004652 发表于 2025-4-28 18:10
支持楼主好人。太惜不能修改动态块

把52行的(setq BlkNam (vla-get-name obj))改成(setq BlkNam (vla-get-effectivename obj))就支持了

网友答:
kozmosovia 发表于 2025-6-16 16:05
把52行的(setq BlkNam (vla-get-name obj))改成(setq BlkNam (vla-get-effectivename obj))就支持了

好像不支持天正的块命名嘞





    祝愿祖国繁荣昌盛

    网友答: 谢谢分享，下载备用

    网友答: 大师呀，膜拜了。

    网友答: 谢谢楼主分享。

    网友答: 我都是搬运大师程序

    网友答: 谢谢楼主分享, 先收藏

    网友答: 谢谢分享, 学习了

    网友答: 比系统自带的方便多了，自带的还得记住名字

    网友答: 謝謝分享，下載備用

    网友答: 下载备用，谢谢分享
  • 上一篇：水专业系统图三通、变径识别
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025