【求助】如何快速删除多条重复的线条

经坛主首肯..,公布源码让大家学习.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun deldup_error (s)
    (if (/= s "功能取消")
        (princ (strcat "\n错误: " s))
    )  
    (setq *error* old_error)
    (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun help_dialog ()
    (if (setq help_file (findfile "deldup.hlp"))
        (progn (setq dia_id (load_dialog "deldub.dcl")
                     help_file (open help_file "r")
                     help_lijst (cons (read-line help_file) help_lijst)
               )
               (new_dialog "help" dia_id)
               (while (setq help_regel (read-line help_file))
                      (setq help_lijst (cons help_regel help_lijst))
               )
               (setq help_file (close help_file)
                     help_lijst (reverse help_lijst)
                     help_regel nil
               )
               (start_list "help_lijst")
               (mapcar 'add_list help_lijst)
               (end_list)
               (setq help_lijst nil)
               (start_dialog)
        )
        (alert "文件不完整!")
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun line ()
    (while (> (sslength alles) 1)          (setq n 1
                 ent (entget (ssname alles 0))
                 b (cdr (assoc 10 ent))
                 e (cdr (assoc 11 ent))
                 leng (sslength alles)
           )
           (repeat (- leng 1)
                   (setq nent (entget (ssname alles n))
                         nb (cdr (assoc 10 nent))
                         ne (cdr (assoc 11 nent))
                   )
                   (if (and (or (equal b nb deldub_tol)
                                (equal b ne deldub_tol)
                            )
                            (or (equal e nb deldub_tol)
                                (equal e ne deldub_tol)
                            )
                       )
                       (progn (ssadd (cdr (car nent)) wis_set)
                              (redraw (cdr (car nent)) 3)
                       )
                       (setq n (1+ n))
                   )
           )
           (ssdel (cdr (car ent)) alles)
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun arc ()
    (while (> (sslength alles) 1)
           (setq n 1
                 ent (entget (ssname alles 0))
                 cen (cdr (assoc 10 ent))
                 rad (cdr (assoc 40 ent))
                 beg (cdr (assoc 50 ent))
                 ein (cdr (assoc 51 ent))
                 leng (sslength alles)
           )
           (repeat (- leng 1)
                   (setq nent (entget (ssname alles n))
                         ncen (cdr (assoc 10 nent))                        nrad (cdr (assoc 40 nent))
                         nbeg (cdr (assoc 50 nent))
                         nein (cdr (assoc 51 nent))
                   )
                   (if (and (equal cen ncen deldub_tol)
                            (equal rad nrad deldub_tol)
                            (or (equal beg nbeg deldub_tol)
                                (equal beg nein deldub_tol)
                            )
                            (or (equal ein nbeg deldub_tol)
                                (equal ein nein deldub_tol)
                            )
                       )
                       (progn (ssadd (cdr (car nent)) wis_set)
                              (redraw (cdr (car nent)) 3)
                       )
                       (setq n (1+ n))
                  )
           )
           (ssdel (cdr (car ent)) alles)
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun circle ()
    (while (> (sslength alles) 1)
           (setq n 1
                 ent (entget (ssname alles 0))                cen (cdr (assoc 10 ent))
                 rad (cdr (assoc 40 ent))
                 leng (sslength alles)
           )
           (repeat (- leng 1)
                   (setq nent (entget (ssname alles n))
                         ncen (cdr (assoc 10 nent))
                         nrad (cdr (assoc 40 nent))
                   )
                   (if (and (equal cen xncen deldub_tol)
                            (equal rad nrad deldub_tol)
                       )
                       (progn (ssadd (cdr (car nent)) wis_set)
                              (redraw (cdr (car nent)) 3)
                       )
                       (setq n (1+ n))
                   )
           )
           (ssdel (cdr (car ent)) alles)
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun text ()
    (while (> (sslength alles) 1)
           (setq n 1
                 ent (entget (ssname alles 0))
                 t (cdr (assoc 1 ent))
                 s (cdr (assoc 7 ent))
                 i (cdr (assoc 10 ent))
                 h (cdr (assoc 40 ent))
                 b (cdr (assoc 41 ent))
                 r (cdr (assoc 50 ent))
                 o (cdr (assoc 51 ent))
                 leng (sslength alles)
           )
           (repeat (- leng 1)
                   (setq nent (entget (ssname alles n))
                         nt (cdr (assoc 1 nent))
                         ns (cdr (assoc 7 nent))
                         ni (cdr (assoc 10 nent))
                         nh (cdr (assoc 40 nent))
                         nb (cdr (assoc 41 nent))
                         nr (cdr (assoc 50 nent))
                         no (cdr (assoc 51 nent))
                   )
                   (if (and (= t nt)
                            (= s ns)
                            (equal i ni deldub_tol)
                            (equal h nh deldub_tol)
                            (equal b nb deldub_tol)
                            (equal r nr deldub_tol)
                            (equal o no deldub_tol)
                       )
                       (progn (ssadd (cdr (car nent)) wis_set)
                              (redraw (cdr (car nent)) 3)
                       )
                       (setq n (1+ n))
                  )
           )
           (ssdel (cdr (car ent)) alles)
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun zoeken ()
    (princ "\r正在搜索 ")
    (princ teller)
    (cond ((= soort "LINE")
           (line)
          )
          ((= soort "ARC")
           (arc)
          )
          ((= soort "CIRCLE")
           (circle)
          )
          ((= soort "TEXT")
           (text)
          )
    )
    (setq gewist (+ gewist (sslength wis_set)))
    (command "erase" wis_set "")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun verzamelen ()
    (setq alles (ssget "C" pt3 pt4 (list (cons 0 soort)))
          teller (1+ teller)
          wis_set (ssadd)
    )
    (if alles
        (zoeken)
        (progn (princ "\r正在搜索 ")
               (princ teller)
        )
    )
    (rechthoek)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun rechthoek ()
    (setq vlist (list 256 pt3 (list (car pt4)(cadr pt3))
                      256 (list (car pt4)(cadr pt3)) pt4
                      256 pt4 (list (car pt3)(cadr pt4))
                      256 (list (car pt3)(cadr pt4)) pt3
                )
    )
    (grvecs vlist)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun deldup ()
    (if (= soort "TEXT")
        (setq deel (1+ (fix (/ (sslength alles) 100))))
        (setq deel (1+ (fix (/ (sslength alles) 100))))
    )
    (setq teller 0
          gewist 0
          hoek (angle pt1 pt2)
          diag (/ (distance pt1 pt2) deel)
          ydir (angle pt1 (list (car pt1)(cadr pt2)))
          ylen (/ (distance pt1 (list (car pt1)(cadr pt2))) deel)
          pt3 pt1
          pt4 (polar pt3 hoek (* deel diag))
    )
    (rechthoek)
    (prompt (strcat "\r分割域" (itoa (* deel deel)) "部分, 正在搜索...\n"))
    (repeat deel
            (setq pt4 (polar pt3 hoek diag))
            (rechthoek)
            (verzamelen)
            (repeat (- deel 1)
                    (setq pt3 (polar pt4 (- ydir pi) ylen)
                          pt4 (polar pt3 hoek diag)
                    )
                    (rechthoek)
                    (verzamelen)
            )
            (setq pt3 (polar pt1 ydir ylen)
                  pt1 pt3
            )
    )
    (redraw)
    (prompt (strcat "\r共删除" (itoa gewist) "个重复" soort))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun tel ()
;   (prompt (strcat "\n窗选包含重复 " soort "的面域."))
    (setq pt1 (getpoint "\n第一点: ")
          pt2 (getcorner pt1 "\r对角点: ")
;         alles (ssget "C" pt1 pt2 (list (cons 0 soort)))
    )
    (SETQ ALLES (SSGET "X" (LIST (CONS 0 "LINE"))))
    (if alles
        (deldup)
        (alert (strcat "找不到" soort "."))
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun deldup_dialog ()
    (setq dia_id (load_dialog "deldup")
          soort "LINE"
    )
    (if (not (new_dialog "deldup" dia_id))
        (alert (strcat "I can't find the file \"DELDUP.DCL\"."
                       "\nI can only search for duplicate \"LINE\"."
               )
        )
        (progn (set_tile "tole" (rtos deldub_tol 2 5))
               (start_dialog)
        )
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:deldup ()
    (setvar "cmdecho" 0)
    (alert "本程序由HTTP://idesign2002.com提供！")
    (setq old_error *error*         *error* deldup_error
    )
    (if (= deldub_tol nil)
        (setq deldub_tol 0.0)
    )
    (deldup_dialog)
    (if soort
        (tel)
    )
    (setq *error* old_error)
    (princ)
)
(defun c:dp()
    (c:deldup)
);end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;