删除同名块，与大家分享一下

zhongys

在用2D拆模图中有很多相同的块，一个个删除比较费事，用这个程式就没有这么麻烦了。这个程式还可以延伸COPY ,MIRROR,MOVE选中同一图层,同名块，因原理是一样，故没有放。
(defun c:erb(/ en san ss sa);删除同名块
(setvar "cmdecho" 0)

(defun *error* (msg)
  ;(princ "出错: ")
  (princ msg)
  (princ)
)
(VL-LOAD-COM)
(while (/= (cdr (assoc 0 en)) "INSERT")
(setq en (entget (CAR (entsel "\n请选择要删除同名块块源对象: "))))
)
(setq san (cdr (assoc 2 en)))
(setq ss (ssget (list '(0 . "INSERT") (cons 2 san))))
(setq sa (vl-princ-to-string (sslength ss)))
(COMMAND "_erase" SS "")
(princ (strcat "块=> “" san "” <=共 " sa " 个已被删除"))
(princ)
)

yhkk0317

这个功能在燕秀工具箱一样,不知谁是原创