删除完全一样的图元

菜卷鱼 · 发表于 2018-5-26 14:04:14

本帖最后由菜卷鱼于 2018-5-28 17:12 编辑

对比的那里不能用单纯用If 去对比，用entget 看到的信息其实有部分精度未显示出来，表面上看数据一模一样，因为显示的精度只有4位小数，实际上可能不止，所以要用equal添加允许误差范围。注：该方法运行对象越多较慢，逐步变慢，超过1万个的时候，就会慢得像蜗牛

。

(defun c:cf (/ inforemove ss n i s a cf_info elist)
(defun inforemove (info)
(mapcar '(lambda (x)
;;匿名函数
(setq info (vl-remove (assoc x info) info))
)
'(-1 330 5 360)
)
info
)
(setq elist (list 0))
(setq ss (ssget))
(setq n (sslength ss))
(setq i 0)
(setq s 0)
(repeat n
(setq a (ssname ss i))
(setq cf_info (inforemove (entget a)))
(if
(apply 'or
(mapcar '(lambda (x) (equal cf_info x 0.0001)) elist))
(progn (entdel a) (setq s (1+ s)))
(setq elist (cons cf_info elist))
)
(setq i (1+ i))
)
(mapcar 'princ (list "共删除" s "个重复对象"))
(prin1)
)

Andyhon · 发表于 2018-5-26 14:50:54

未考量精度
此外亦未考量起点终点交换的问题

可调用 overkill 做比较

菜卷鱼 · 发表于 2018-5-26 15:11:01

Andyhon 发表于 2018-5-26 14:50
未考量精度
此外亦未考量起点终点交换的问题

请教能否编一个像ET中OVERKILL命令一样lisp,删除的图中有一些重叠的圆和文字?
http://bbs.mjtd.com/forum.php?mo ... &fromuid=399892
(出处: 明经CAD社区)

跟这个帖子4楼G版的处理结果一样

evayleung · 发表于 2018-5-26 22:06:05

CAD自带的已经很强了吧，不过还是希望楼主做个更强的，然后分享一下，我个人也喜欢用LISP，暂时没办法，只能用CAD的。

Andyhon · 发表于 2018-5-27 10:19:51

OverKill有Lsp版呀

菜卷鱼 · 发表于 2018-5-28 08:44:06

Andyhon 发表于 2018-5-27 10:19
OverKill有Lsp版呀

我们公司用的正版CAD，没买Express Tools ，没有OVERKILL命令

Andyhon · 发表于 2018-5-28 09:20:50

网海捞呗

qhdycm2017 · 发表于 2018-5-28 19:56:27

有lisp版改改就是了

oistre · 发表于 2018-8-20 00:18:38

顶一个，，，，，，，

oistre · 发表于 2018-8-28 11:45:13

感谢分享程序!!!!

账号		自动登录	找回密码
密码			注册

[讨论] 删除完全一样的图元

本帖子中包含更多资源