图块名快速修改

glcsq

;;图块快速改名
(defun c:tkren ( / ss frontname j bname newname doc blks blkcount i)
  (vl-load-com)
  (setvar 'cmdecho 0)
  (prompt "\n选择要修改的图块：")
  (setq ss (ssget '((0 . "INSERT"))))
  (if ss
      (progn
      (setq ss (RemoveDuplicateBlocks ss)) ;去掉图块名相同的图块
      (setq frontname (getstring "\n原图块名增加前缀为：")) ; 设置新图块名
      (setq j 0)
      (while (< j (sslength ss))
       (setq bname (cdr (assoc 2 (entget (ssname ss j)))))
       (setq newname (strcat frontname bname "-" (itoa (+ j 1))))
       (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
       (setq blks (vla-get-Blocks doc))
       (setq blkcount (vla-get-Count blks))
       (setq i 0)
       (while (< i blkcount)
         (setq blk (vla-item blks i))
         (if (equal (vla-get-Name blk) bname) ; 找到要替换的图块名称
             (vla-put-Name blk newname)  ; 修改图块名称
         ) ;endif
        (setq i (1+ i))
       );end while
       (setq j (1+ j))
       );end while
      (print "图块名修改完成！")
      );end progn
  );endif
  (setvar 'cmdecho 1)
  (princ)
)

(defun RemoveDuplicateBlocks (ss / i blk blknames)
      (setq blknames '())
      (repeat (setq i (sslength ss))
        (setq blk (ssname ss (setq i (1- i))))
        (setq blkname (cdr (assoc 2 (entget blk))))
        (if (not (member blkname blknames))
          (setq blknames (cons blkname blknames))
          (setq ss (ssdel blk ss))
        )
      )
  ss
)

你有种再说一遍

在 CAD 中，修改块名的命令是“RENAME”。

操作步骤如下：

1.输入“RENAME”命令并按下回车键。
2.在弹出的“重命名”对话框中，选择“块”选项。
3.然后在“旧名称”栏中选择要修改名称的块。
4.在“新名称”栏中输入新的块名称。
5.最后点击“确定”按钮完成块名的修改。

glcsq

nsh935 发表于 2024-7-19 08:37
图块改名是改了选中的那一个图块还是所有同名的都会被改？

相同名的图块都会修改

758586

抢了个沙发

tensir

感谢作者的分享！

zm880928

请问这程序主要 用在哪里呢

w379106181

感谢作者的分享！

MZ_li

感谢作者的分享！

hubeiwdlue

谢谢楼主分享。

XPG

感谢分享？

gble119

多谢分享  支持楼主