(remore)消除合并重复直线

;;说明:消除合并重复直线程序(【直线消重】分离于=>***消除合并重复直线、圆弧或圆yad_undup***  YAD建筑")
;;参数:ss:需要消重的选择集
;;返回:消重后的选择集
(defun remore(sss / chg_ent dxf on_ent os pmt sdel tang undup)
            (defun dxf(ent i)
                (cdr (assoc i (entget ent)))
            )
            (defun tang(ang sty)
                (rem (+ (* 2 pi) 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)
                (equal (+ (distance a1 a) (distance a a2)) (distance a1 a2) 0.01)
            )
            (defun undup(s / c ent ent1 ent2 ept1 ept2 m n nm sdels spt1 spt2 ss)
                (setq n -1 nm 0 sdels s)
                (while (setq ent1 (ssname s (setq n (1+ n))))
                    (if (entget ent1)
                        (progn
                            (setq spt1 (dxf ent1 10) ept1 (dxf ent1 11))
                            (if (setq ss (ssget "cp" (list (polar spt1 (angle ept1 spt1) 0.1)
                                                                                 (polar ept1 (- (angle spt1 ept1) (/ pi 4)) 0.15)
                                                                                 (polar ept1 (+ (angle spt1 ept1) (/ pi 4)) 0.15)
                                                                             ) '((0 . "line"))
                                                     )
                                    )
                                (progn
                                    (ssdel ent1 ss)
                                    (setq m -1 c (sslength ss))
                                    (repeat c
                                        (setq ent (ssname ss (setq m (1+ m))))
                                        (if (not (ssmemb ent s))
                                            (progn
                                                (ssdel ent ss)
                                                (setq m (1- m))
                                            )
                                        )
                                    )
                                    (setq m -1 c (sslength ss))
                                    (repeat c
                                        (setq ent2 (ssname ss (setq m (1+ m))))
                                        (setq spt2 (dxf ent2 10) ept2 (dxf ent2 11))
                                        (cond
                                            ((and (on_ent spt2 spt1 ept1) (on_ent ept2 spt1 ept1))
                                                (entdel ent2)
                                                (if (ssmemb ent2 sdels) (ssdel ent2 sdels))
                                            )
                                            ((and (on_ent spt1 spt2 ept2) (on_ent ept1 spt2 ept2))
                                                (entdel ent1)
                                                (if (ssmemb ent1 sdels) (ssdel ent1 sdels))
                                                (setq ent1 ent2 spt1 spt2 ept1 ept2)
                                            )
                                            ((and (equal (tang (angle spt1 ept1) pi) (tang (angle spt2 ept2) pi) 0.001)
                                                 (or (on_ent spt2 spt1 ept1) (on_ent ept2 spt1 ept1))
                                             )
                                                (entdel ent2)
                                                (if (ssmemb ent2 sdels) (ssdel ent2 sdels))
                                                (progn
                                                    (if (on_ent spt2 spt1 ept1)
                                                        (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))
                                    )
                                )
                            )
                        )
                    )
                )
                sdels
            )
            (command "_.undo" "_be")
            (command "_.ucs" "")
            (setq os (getvar "osmode") sdel (ssadd))
            (setvar "cmdecho" 0)
            (setvar "osmode" 0)
            (if (> (sslength sss) 1) (progn (setq sdel (undup sss)) (setq pmt T)) (setq sdel sss))
            (if (and sss (not pmt)) sss)
            (setvar "osmode" os)
            (command "_.undo" "_e")
            sdel
        )