;;图块快速改名
(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
)
| 
