明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1399|回复: 21

[提问] 删除重复线代码 求改进!

[复制链接]
发表于 2025-6-12 10:07:57 | 显示全部楼层 |阅读模式
在论坛收集了好多删除重复线的代码  这个是我收集到的最好用的  但是有两个缺点 1:只能删除 直线和圆弧 2:只能删除相同图层的线
求改进 1:让程序支持 删除 重复 直线 块 多段线  多义线  样条曲线 等所有类型 :2: 让程序支持 哪怕不在一个图层的重复线也能被删除掉
谢谢大神们了


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
"觉得好,就打赏"
还没有人打赏,支持一下
回复

使用道具 举报

发表于 2025-6-21 23:16:34 | 显示全部楼层
论坛有,忘记原帖是谁的了
快捷键  eq  合并重叠线
(defun c:eq (/ jlgc in nor dxf tang chg_ent on_ent undup 2pi sline sarc scircle n ss ent pmt copyss subss)
(if (setq in (getreal "\n输入距离公差<0.01>:"))
(setq jlgc in)
(setq jlgc 0.01))
(defun copyss (s / ss tn)
(setq ss (ssadd))
(setq tn -1)
(repeat (sslength s)
(ssadd (ssname s (setq tn (1+ tn))) ss)))
(defun subss (ss1 ss2 / ten tn)
(setq tn -1)
(repeat (sslength ss2)
(setq ten (ssname ss2 (setq tn (1+ tn))))
(if (ssmemb ten ss1)
(ssdel ten ss1))))
(defun dxf (ent i)
(cdr (assoc i (entget ent))))
(defun tang (ang sty)
(rem (+ 2pi ang) sty))
(defun chg_ent (ent i pt / en)
(setq en (entget ent)
en (subst (cons i pt) (assoc i en) en))
(entmod en))
(defun on_ent (a a1 a2 sty)
(if (= sty "直线")
(equal (+ (distance a1 a) (distance a a2))
(distance a1 a2) jlgc)
(if (> a2 a1)
(and (> a2 (- a 1e-5)) (> a (- a1 1e-5)))
(or (> a2 (- a 1e-5)) (> a (- a1 1e-5))))))
(defun undup (s sty / nm m na ss ent1 spt1 ept1 cpt1 r1 ent2 spt2 ept2 cpt2 r2)
(setq n  -1 nm 0 na 0)
(cond
((= sty "圆")
(repeat (sslength s)
(setq ent1 (ssname s (setq n (1+ n))))
(if (entget ent1)
(progn
(setq cpt1 (dxf ent1 10) r1 (dxf ent1 40))
(if (> (sslength s) 1)
(progn
(setq ss (copyss s))
(ssdel ent1 ss)
(setq m -1)
(repeat (sslength ss)
(setq ent (ssname ss (setq m (1+ m))))
(if (or (not (equal (dxf ent 40) r1 1e-5))
(> (distance (dxf ent 10) cpt1) 1e-5))
(progn
(ssdel ent ss)
(setq m (1- m)))))
(vl-cmdf "_.erase" ss "")
(setq nm (+ nm (sslength ss)))))
(if (> (sslength sarc) 0)
(progn
(setq ss (copyss sarc))
(setq m -1)
(repeat (sslength ss)
(setq ent (ssname ss (setq m (1+ m))))
(if (or (not (equal (dxf ent 40) r1 1e-5))
(> (distance (dxf ent 10) cpt1) 1e-5))
(progn
(ssdel ent ss)
(setq m (1- m)))))
(subss sarc ss)
(vl-cmdf "_.erase" ss "")
(setq na (+ na (sslength ss)))))))))
((= sty "直线")
(repeat (sslength s)
(setq ent1 (ssname s (setq n (1+ n))))
(if (entget ent1)
(progn
(setq spt1 (dxf ent1 10)
ept1 (dxf ent1 11))
(if (> (sslength s) 1)
(progn
(setq ss (copyss s))
(ssdel ent1 ss)
(setq m -1)
(repeat (sslength ss)
(setq ent2 (ssname ss (setq m (1+ m))))
(setq spt2 (dxf ent2 10)
ept2 (dxf ent2 11))
(if (and spt2 ept2 spt1 ept1)
(progn
(cond
((and (on_ent spt2 spt1 ept1 sty)
(on_ent ept2 spt1 ept1 sty))
(entdel ent2))
((and (on_ent spt1 spt2 ept2 sty)
(on_ent ept1 spt2 ept2 sty))
(entdel ent1)
(setq ent1 ent2 spt1 spt2 ept1 ept2))
((and (and (setq nor (mapcar '- spt1 ept1))
(< (abs (- (car (trans spt2 0 nor))
(car (trans spt1 0 nor)))) jlgc)
(< (abs (- (car (trans ept2 0 nor))
(car (trans spt1 0 nor)))) jlgc))
(or (on_ent spt2 spt1 ept1 sty)
(on_ent ept2 spt1 ept1 sty)))
(entdel ent2)
(if (on_ent spt2 spt1 ept1 sty)
(setq spt2 ept2))
(if (> (distance spt1 spt2)
(distance ept1 spt2))
(progn (chg_ent ent1 11 spt2)
(setq ept1 spt2))
(progn (chg_ent ent1 10 spt2)
(setq spt1 spt2))))
(T (setq nm (1- nm))))
(setq nm (1+ nm)))))))))))
(t (repeat (sslength s)
(setq ent1 (ssname s (setq n (1+ n))))
(if (entget ent1)
(progn
(setq spt1 (tang (dxf ent1 50) 2pi)
ept1 (tang (dxf ent1 51) 2pi)
cpt1 (dxf ent1 10)
r1 (dxf ent1 40))
(if (> (sslength s) 1)
(progn
(setq ss (copyss s))
(ssdel ent1 ss)
(setq m -1)
(repeat (sslength ss)
(setq ent2 (ssname ss (setq m (1+ m))))
(if (entget ent2)
(progn
(setq spt2 (tang (dxf ent2 50) 2pi)
ept2 (tang (dxf ent2 51) 2pi)
cpt2 (dxf ent2 10)
r2   (dxf ent2 40))
(if (and spt2 ept2 cpt2 r2)
(progn
(cond
((and (< (distance cpt1 cpt2) 1e-5)
(on_ent spt2 spt1 ept1 sty)
(on_ent ept2 spt1 ept1 sty))
(entdel ent2))
((and
(< (distance cpt1 cpt2) 1e-5)
(on_ent spt1 spt2 ept2 sty)
(on_ent ept1 spt2 ept2 sty))
(entdel ent1)
(setq ent1 ent2 spt1 spt2 ept1 ept2)
(setq cpt1 cpt2 r1   r2))
((and (< (distance cpt1 cpt2) 1e-5)
(or (on_ent spt2 spt1 ept1 sty)
(on_ent ept2 spt1 ept1 sty)))
(entdel ent2)
(if (on_ent spt2 spt1 ept1 sty)
(progn (chg_ent ent1 51 ept2)
(setq ept1 ept2))
(progn (chg_ent ent1 50 spt2)
(setq spt1 spt2))))
(T (setq nm (1- nm))))
(setq nm (1+ nm))))))))))))))
(prompt (strcat "\n选择" (itoa (sslength s)) "个" sty "消去" (itoa nm) "个!"))
(if (> na 0) (prompt (strcat "消去" (itoa na) "个圆弧!"))))
(setq 2pi (* 2 pi) sline (ssadd) sarc  (ssadd) scircle (ssadd) n -1)
(setvar "cmdecho" 0)
(vl-cmdf "_.undo" "_be")
(prompt "\n请选择直线、圆弧或圆:")
(if (setq ss (ssget '((0 . "line,arc,circle"))))
(progn
(prompt "\n正在消除合并重复线条,请稍候...\n")
(repeat (sslength ss)
(setq ent (ssname ss (setq n (1+ n))))
(cond
((= (dxf ent 0) "LINE") (ssadd ent sline))
((= (dxf ent 0) "ARC") (ssadd ent sarc))
((= (dxf ent 0) "CIRCLE") (ssadd ent scircle))))))
(if (> (sslength sline) 1)
(progn (undup sline "直线") (setq pmt T)))
(if (or (> (sslength scircle) 1)
(and (= (sslength scircle) 1) (> (sslength sarc) 0)))
(progn (undup scircle "圆") (setq pmt T)))
(if (> (sslength sarc) 1)
(progn (undup sarc "圆弧") (setq pmt T)))
(if (and ss (not pmt))
(prompt "\n没有重复实体!"))
(vl-cmdf "_.undo" "_e")
(princ))
(princ)
回复 支持 反对

使用道具 举报

发表于 2025-6-12 14:15:39 | 显示全部楼层
本帖最后由 你有种再说一遍 于 2025-6-12 16:42 编辑
依然小小鸟 发表于 2025-6-12 12:09
那就实现 不同图层的重复线 也可以删掉 也行

1,按照包围盒左下右上排序数组.
2,数量 / (CPU核心数*2) = 分块数,
多线程处理每个分块任务,向后搜索碰撞即可.
已经完成任务的线程进行工作窃取.
3,得到碰撞的,再两两比较一下.
多线程检索,百万图元也只需要1s吧.
如果数量超过一千万,那么就需要先哈希网格,再并行每个网格.
回复 支持 反对

使用道具 举报

 楼主| 发表于 2025-6-12 15:15:52 | 显示全部楼层
你有种再说一遍 发表于 2025-6-12 14:15
1,按照包围盒左下右上排序数组.
2,数量/CPU核心数,多线程从分块向后搜索.
3,得到碰撞的,再两两比较一下 ...

我不会写代码
回复 支持 反对

使用道具 举报

发表于 2025-6-12 10:17:03 | 显示全部楼层
多谢楼主分享,下载试用下
回复 支持 反对

使用道具 举报

发表于 2025-6-12 10:29:07 | 显示全部楼层
overkill不够用?
回复 支持 反对

使用道具 举报

 楼主| 发表于 2025-6-12 10:57:58 | 显示全部楼层

不太好用 有些重复线 还是删不掉

点评

误差取大一些  发表于 2025-6-12 11:04
回复 支持 反对

使用道具 举报

发表于 2025-6-12 11:08:31 | 显示全部楼层
感谢分享  收了备用。。  [现在CAD都自带删除重复线了]
回复 支持 反对

使用道具 举报

发表于 2025-6-12 11:14:28 | 显示全部楼层
小鸟 发表于 2025-6-12 11:08
感谢分享  收了备用。。  [现在CAD都自带删除重复线了]

自带的怎么用
回复 支持 反对

使用道具 举报

 楼主| 发表于 2025-6-12 11:44:27 | 显示全部楼层

自带的是overkill命令
回复 支持 反对

使用道具 举报

发表于 2025-6-12 11:51:57 | 显示全部楼层
块,样条曲线我觉得不可能实现
回复 支持 反对

使用道具 举报

 楼主| 发表于 2025-6-12 12:09:11 | 显示全部楼层
south 发表于 2025-6-12 11:51
块,样条曲线我觉得不可能实现

那就实现 不同图层的重复线 也可以删掉 也行
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-7-14 17:34 , Processed in 0.206533 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表