[分享]：清除重复的圆

sdwy19691229

画图过程中，难免有重复的图元，为此我编写了几个程序！

清除重复的圆
(defun C:DC (/ m os p1 p2 P n pl e ena eaa paa Rpp A M pl Q nu nb)
             (setq m:err *error* *error* *merr*)
             (setvar "cmdecho" 0)
             (command "UNDO" "G")
             (command "ucs" "w")
             (setq os (getvar "osmode"))
             (setvar "osmode" 0)  
             (prompt "选择图形")
             (setq p1 (getpoint "\n请输入第一角点:"))
             (if (/= p1 nil)(progn
             (initget 32)
             (setq p2 (getcorner p1 "\n请输入另一角点:"))
             (if (/= p2 nil)(progn
             (princ "\n请稍候......")

      **** (setq P (ssget "C" p1 p2 '((0 . "CIRCLE"))  ))
             (if (/= p nil)(progn
             (setq n (sslength p) pl 0)
             (while (< pl n)
             (setq e (entget (ssname p pl)))
             (setq ena (cdr (assoc '-1 e)))
             (setq eaa (assoc '0 e))
             (setq paa (assoc '10 e))
             (setq Rpp (assoc '40 e))
             (setq A (ssget "C" p1 p2 (list eaa paa Rpp) ))
             (setq M (sslength A))
             (if (>= M 2) (entdel ena ) )
             (setq pl (1+ pl))
             )
             (setq Q (ssget "C" p1 p2 '((0 . "CIRCLE"))  ))
             (setq nu (sslength Q))
             (setq nb (- n nu))
             (princ "\n共删除<圆> ")(princ nb)(princ " 个")
             ) )  
         
             ))  ))   
             (setvar "osmode" os)
             (command "ucs" "p")
             (command "UNDO" "E")  
             (princ)  )  ****

fools

感谢分享，先顶一下
提点意见，你上面的程序没有考虑圆与弧重叠，或圆与圆环重叠，或弧与圆环重叠的情况，你有兴趣的话建议增加，
若是再考虑到块的因素，以及块内镶套块的情况，用现在的算法就不太合适了。
另外，请问有没有消除多义线与多义线，直线与直线，多义线与直线重复的程序

ycao

正需要这个程序，谢谢！

ywx0576

最初由 fools 发布
[B]感谢分享，先顶一下
提点意见，你上面的程序没有考虑圆与弧重叠，或圆与圆环重叠，或弧与圆环重叠的情况，你有兴趣的话建议增加，
若是再考虑到块的因素，以及块内镶套块的情况，用现在的算法就不太合适了。
另外... [/B]

我也在找"多义线与多义线，直线与直线，多义线与直线重复的程序",不知哪位老兄有?

zb_lou

正想要这种LSP程序！还有其他的重覆图元消除的LSP程序吗？非常期待！！

它山之石

还是用晓东工具箱里的［消除重线］命令吧。或者用晓东API里函数就可以了。

xdrx_curve_remove_dup

功    能：消除重线（line,arc,polyline）

调用格式：(xdrx_curve_remove_dup <选择集> ["图层"][超短线长度])

返 回 值：表 (总曲线数 剩余曲线数 超短线数)

说    明：参数： ["图层"]--字符串，剩余曲线存放的层

                 [超短线] -- 实数或整数，小于该值的都删除

zb_lou

非常感谢！！请问版主还有没有其他图元的消重元程序？非常期待.......

yuer0103

消重线的程序LISP比较难做。

taner

2006裏的OVERKILL不是可以麽?

eachy

消重的算法中关键要排序，选择合适的特征作为索引，比如园和弧，取圆心和半径作为特征索引排序，将选择集根据特征索引构造表。有了表再计算每个表内需要保留的对象，如果表内有园，只保留一个园其他的就都可以删除；如果表内都是圆弧，取出最小角和最大角构造一个ARC，其他的都删除。这样才是消重（合并）。
对于Pline可以先行分解为简单的 Line  arc ，然后进行消重，但是Pline的实体信息要单独构造一个表，以便于最后恢复 Pline。

当然如果使用AutoCAD 2006 或者 Map 3D 或者 Civil 3D 编程就省事很多或者不必编程。

SunSpring

2006里的join可以消除重线

zb_lou

我依照楼主的程序照葫芦搞了一个消重直线的程序，运行正常。但速度比较慢。
应该是算法的问题，楼主和斑竹能否依上面的程序搞一个较好的算法吗？（LISP的）
非常感谢。。。

unbos

我用晓东工具箱的消重线功能无法消除探索者的重实体。如：桩

xagh

谢谢，指导。