如何删除重复线？困扰我十几个月了的一个大问题

kinglzk2000

好像不好使啊   直接就放大了一下   ？？？

AMTONNY

直接用楼上所推荐的OV 好了

lixy

非常不错的删重复代码，感谢

328302216

congcong 发表于 2003-2-22 15:33

楼主能不能你的这个程序发给我啊？我也整了半年了都没有整出来！如果楼主能给个源码小弟感激不尽！（我的QQ89305065）

langjs

以前在明经下载的程序：
;;; ===========================================================
;;; 图元合并(删除图纸中重叠的线、圆、圆弧、块)
;;; 命令：  tyhb
;;; ===========================================================
(defun c:tyhb (/ arc_list ent i line_list ss)
  (setvar "cmdecho" 0)                 ; 关闭命令响应
  (command ".UNDO" "BE")
  (while (and
           (setq ss (ssget (list (cons -4 "<or") (cons 0 "arc") (cons 0 "CIRCLE") (cons 0 "line") (cons 0 "INSERT") (cons -4 "or>"))))
           (> (sslength ss) 0)
         )
    (hbzhx ss)
  )
  (command ".UNDO" "E")
  (princ)
)
(defun cs_pross (to i / cs_text myi)
  (setq cs_text ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>")
  (setq myi (fix (/ (* (strlen cs_text) i) to))
        cs_text (substr cs_text 1 myi)
  )
  (grtext -2 cs_text)
)
(defun hbzhx (ss / arc_list ent i line_list ss jd) ;     转为数据表
  (grtext -2 "正在整理数据")
  (setq i 0
        jd 1e-5
        line_list '()
        arc_list '()
        ss100 (ssadd)
  )
  (repeat (sslength ss)
    (setq ent (ssname ss i)
          i (1+ i)
    )
    (if (= "INSERT" (cdr (assoc 0 (entget ent))))
      (ssadd ent ss100)
      (if (= "LINE" (cdr (assoc 0 (entget ent))))
        (setq line_list (cons (line_data ent) line_list))
        (setq arc_list (cons (arc_data ent) arc_list))
      )
    )
  )
  (setq ss100 (congfukuai ss100))
  (setq line_list (vl-sort line_list '(lambda (e1 e2)
                                        (if (equal (car e1) (car e2) jd)
                                          (if (equal (cadr e1) (cadr e2) jd)
                                            (if (equal (car (caddr e1)) (car (caddr e2)) jd)
                                              (< (cadr (caddr e1)) (cadr (caddr e2)))
                                              (< (car (caddr e1)) (car (caddr e2)))
                                            )
                                            (< (cadr e1) (cadr e2))
                                          )
                                          (< (car e1) (car e2))
                                        )
                                      )
                  )
  )
  (setq arc_list (vl-sort arc_list '(lambda (e1 e2)
                                      (if (equal (car e1) (car e2) jd)
                                        (if (equal (cadr e1) (cadr e2) jd)
                                          (if (equal (caddr e1) (caddr e2) jd)
                                            (< (cadddr e1) (cadddr e2))
                                            (< (caddr e1) (caddr e2))
                                          )
                                          (< (cadr e1) (cadr e2))
                                        )
                                        (< (car e1) (car e2))
                                      )
                                    )
                 )
  )
  (if line_list
    (hb_line line_list jd)
  )
  (if arc_list
    (hb_arc arc_list jd)
  )
  (grtext)
  (princ)
)
(defun hb_line (line_list jd / b biaoji data ent k line_a line_b p1 p2 p3 p4 p5 jd xuhao zongshu i lay)
  (setq zongshu (length line_list)
        i 0
        xuhao 0
  )
  (princ (strcat "\n共处理" (rtos zongshu) "个实体"))
  (grtext -1 "合并直线")
  (while (> (length line_list) 0)
    (setq xuhao (1+ xuhao))
    (cs_pross zongshu xuhao)
    (setq line_a (car line_list)
          line_list (cdr line_list)
          biaoji t
          k (car line_a)
          b (cadr line_a)
          p1 (caddr line_a)
          p2 (cadddr line_a)
          ent (last line_a)
          lay (cdr (assoc 8 (entget ent)))
    )
    (while (and
             biaoji
             (> (length line_list) 0)
           )
      (setq line_b (car line_list))
      (cond
        ((and
           (equal k (car line_b) jd)
           (equal b (cadr line_b) jd)
           (= lay (cdr (assoc 8 (entget (last line_b)))))
         )
          (setq p3 (caddr line_b)
                p4 (cadddr line_b)
                p5 (vl-sort (list p1 p2 p3 p4) '(lambda (e1 e2)
                                                  (if (equal (car e1) (car e2) jd)
                                                    (< (cadr e1) (cadr e2))
                                                    (< (car e1) (car e2))
                                                  )
                                                )
                   )
                p4 (cadr p5)
          )
          (if (or
                (equal p1 p4 jd)
                (equal p3 p4 jd)
              )
            (progn
              (setq p1 (car p5)
                    p2 (last p5)
                    line_list (cdr line_list)
              )
              (entdel (last line_b))
              (setq xuhao (1+ xuhao))
              (cs_pross zongshu xuhao)
              (setq i (1+ i))
            )
            (setq biaoji nil)
          )
        )
        (t
          (setq biaoji nil)
        )
      )
    )
    (setq data (entget ent)
          data (subst
                 (cons 10 p1)
                 (assoc 10 data)
                 data
               )
          data (subst
                 (cons 11 p2)
                 (assoc 11 data)
                 data
               )
    )
    (entmod data)
  )
  (princ (strcat "，删除了" (rtos i) "个实体"))
  (princ)
)
(defun hb_arc (arc_list jd / i arc_a arc_b biaoji bj data eangl eangl1 ent jd line_list p5 pc sangl sangl1 xuhao zongshu lay)
  (setq zongshu (length arc_list)
        xuhao 0
        i 0
  )
  (princ (strcat "\n共处理" (rtos zongshu) "个实体"))
  (grtext -1 "合并圆弧")
  (while (> (length arc_list) 0)
    (setq xuhao (1+ xuhao))
    (cs_pross zongshu xuhao)
    (setq arc_a (car arc_list)
          arc_list (cdr arc_list)
          biaoji t
          bj (car arc_a)
          pc (list (cadr arc_a) (caddr arc_a))
          sangl (cadddr arc_a)
          eangl (nth 4 arc_a)
          ent (last arc_a)
          lay (cdr (assoc 8 (entget ent)))
    )
    (while (and
             biaoji
             (> (length arc_list) 0)
           )
      (setq arc_b (car arc_list))
      (cond
        ((and
           (equal bj (car arc_b) jd)
           (equal pc (list (cadr arc_b) (caddr arc_b)) jd)
           (= lay (cdr (assoc 8 (entget (last arc_b)))))
         )
          (setq sangl1 (cadddr arc_b)
                eangl1 (nth 4 arc_b)
                p5 (vl-sort (list sangl eangl sangl1 eangl1) '(lambda (e1 e2)
                                                                (< e1 e2)
                                                              )
                   )
                sangl1 (nth (- (length p5) 2) p5)
          )
          (if (or
                (equal eangl sangl1 jd)
                (equal eangl1 sangl1 jd)
              )
            (progn
              (setq sangl (car p5)
                    eangl (last p5)
                    arc_list (cdr arc_list)
              )
              (entdel (last arc_b))
              (setq xuhao (1+ xuhao))
              (cs_pross zongshu xuhao)
              (setq i (1+ i))
            )
            (setq biaoji nil)
          )
        )
        (t
          (setq biaoji nil)
        )
      )
    )
    (setq data (entget ent)
          data (subst
                 (cons 50 sangl)
                 (assoc 50 data)
                 data
               )
          data (subst
                 (cons 51 eangl)
                 (assoc 51 data)
                 data
               )
    )
    (entmod data)
  )
  (princ (strcat "，删除了" (rtos i) "个实体"))
  (princ)
)
(defun arc_data (ent / bj data eangl pc sangl)
  (setq data (entget ent))
  (setq bj (cdr (assoc 40 data)))
  (setq pc (cdr (assoc 10 data)))
  (setq sangl (cdr (assoc 50 data)))
  (setq eangl (cdr (assoc 51 data)))
  (if (not sangl)
    (setq sangl 0.0
          eangl (+ pi pi)
    )
  )
  (if (< eangl sangl)
    (setq eangl (+ eangl (+ pi pi)))
  )
  (list bj (car pc) (cadr pc) sangl eangl ent)
)
(defun line_data (ent / b k p1 p2 jd)
  (setq p1 (vlax-curve-getstartpoint ent)
        p2 (vlax-curve-getendpoint ent)
        jd 1e-5
  )
  (if (equal (car p1) (car p2) jd)
    (setq k nil
          b (car p1)
    )
    (setq k (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1)))
          b (- (cadr p1) (* (car p1) k))
    )
  )
  (setq p2 (vl-sort (list p1 p2) '(lambda (e1 e2)
                                    (if (equal (car e1) (car e2) jd)
                                      (< (cadr e1) (cadr e2))
                                      (< (car e1) (car e2))
                                    )
                                  )
           )
        p1 (car p2)
        p2 (cadr p2)
  )
  (list k b (list (car p1) (cadr p1)) (list (car p2) (cadr p2)) ent)
)
;;; -------------------------------------------------------------
;;; 删除重块
(defun congfukuai (ss / i layb n ss1 ss88 ss99 ssb ssb0 ssn ssn1 u)
  (setq u 0
        ss88 (ssadd)
        ss99 (ssadd)
  )
  (while (< u (sslength ss))
    (setq ssn (ssname ss u))
    (ssadd ssn ss88)
    (ssadd ssn ss99)
    (setq u (+ u 1))
  )
  (setq n 0
        ss1 (ssadd)
  )
  (while (< n (sslength ss))
    (setq ssn (ssname ss n))
    (setq layb (assoc '8 (entget ssn)))
    (setq ssb0 (member layb (entget ssn)))
    (setq i 0)
    (ssdel ssn ss88)
    (while (< i (sslength ss88))
      (setq ssn1 (ssname ss88 i))
      (setq layb (assoc '8 (entget ssn1)))
      (setq ssb (member layb (entget ssn1)))
      (if (equal ssb0 ssb)
        (progn
          (ssadd ssn1 ss1)
          (ssdel ssn1 ss99)
        )
      )
      (setq i (+ i 1))
    )
    (setq n (+ n 1))
  )
  (setq n (sslength ss1))
  (princ (strcat "删除了" (rtos n 2 0) "个重块!"))
  (command "erase" ss1 "")
  SS99
)

jfxia

          快速工具中的Overkill   是最好的消重工具之一

328302216

感谢langjs 把源码共享 很好的一个程序！

sicky111

楼上两段程式都试了，没效果。

lizhiqiang9801

我也想找个删除不同图层同位置的重复线  找了好久了 没找到

konoko

overkill 一天内看到两帖同样的问题。纳闷