Duplicate lines

Duplicate lines

Back when, I downloaded a little lisp program that would check a drawing for duplicate lines. My hard drive failed two years ago, taking most of the LISP software not often used with it. That web site that I obtained it from is no longer running also, so can not go back there today for another copy.

But basically what it did was to check that a drawing did not have one line was not smack on top of another to same exact alignment. Thus making the plotter show up with two (or three) instead of just one.

I just got off one drawing that had 27 lines placed in an area, when only 12 were being shown. Anyone heard of this LISP program before, and now know where to get a copy?

Wm.

Try Overkill command at the command line. Not sure when that was added to express tool /VIP but worth a try.

The OP is using a pre-2000 version of AutoCAD. The Overkill command was added in 2004 I believe as part of Express Tools as you mention.

check the lisp section, i think theres one in there that does that

apparently remark knew where to look because he found this. try it out and let us know if it works

; DELDUP.LSP
;                       Theo L.A. Groenenberg
;                       Leusden NL
;                       [email="acadvice@worldonline.nl"]acadvice@worldonline.nl[/email]
;                       [url]http://www.dra.nl/~acadvice[/url]
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun deldup_error (s)
  (if (/= s "Function cancelled")
      (princ (strcat "\nError: " s))
  ) 
  (setq *error* old_error)
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun help_dialog (/ help_file dia_id help_lijst help_regel)
  (if (setq help_file (findfile "deldup.hlp"))
      (progn (setq dia_id (load_dialog "deldup.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)
             )
             (start_list "help_lijst")
             (mapcar 'add_list help_lijst)
             (end_list)
             (start_dialog)
      )
      (alert "I can't find the file DELDUP.HLP")
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun line (/ n ent b e leng nent nb ne)
  (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 (/ n ent cen rad beg ein leng nent ncen nrad nbeg nein)
  (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 (/ n ent cen rad leng nent ncen nrad)
  (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 (/ n ent t s i h b r o leng nt ns ni nh nb nr no)
  (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 "\rSearching in part ")
  (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 (/ alles wis_set)
  (setq alles (ssget "C" pt3 pt4 (list (cons 0 soort)))
        teller (1+ teller)
        wis_set (ssadd)
  )
  (if alles
      (zoeken)
      (progn (princ "\rSearching in part ")
             (princ teller)
      )
  )
  (rechthoek)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun rechthoek (/ vlist)
  (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 (/ deel teller gewist hoek diag ydir ylen pt3 pt4)
  (if (= soort "TEXT")
      (setq deel (1+ (fix (/ (sslength alles) 10))))
      (setq deel (1+ (fix (/ (sslength alles) 50))))
  )
  (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 "\rDividing the area in " (itoa (* deel deel)) " parts, and searching.\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 "\rErased " (itoa gewist) " duplicate " soort " in total."))
  (prompt "\nRegards, Theo.")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun tel (/ pt1 pt2 alles)
  (prompt (strcat "\nSelect the area containing duplicate " soort "."))
  (setq pt1 (getpoint "\nFirst corner? ")
        pt2 (getcorner pt1 "\rOpposite corner? ")
        alles (ssget "C" pt1 pt2 (list (cons 0 soort)))
  )
  (if alles
      (deldup)
      (alert (strcat "No " soort " found in this area."))
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun deldup_dialog (/ dia_id)
  (setq dia_id (load_dialog "deldup"))
  (if (not (new_dialog "deldup" dia_id))
      (alert (strcat "I can't find the file \"DELDUB.DCL\"."
                     "\nI can only search for duplicate \"LINE\"."
             )
      )
      (progn (set_tile "L" "1")
             (set_tile "tole" (rtos deldub_tol 2 5))
             (start_dialog)
      )
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:deldup (/ soort)
  (setvar "cmdecho" 0)
  (setq old_error *error*
        *error* deldup_error
        soort "LINE"
  )
  (if (= deldub_tol nil)
      (setq deldub_tol 0.0)
  )
  (deldup_dialog)
  (if soort
      (tel)
  )
  (setq *error* old_error)
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

DELDUP.DCL

Coosbay:

You do know how to load a LISP routine right?

his post said he does, said he used to have a lisp to do it but lost it when his hard drive died

Then let's hope everything works out for him. Over and out.

Coosbay:

 

You do know how to load a LISP routine right?

Yepp...

I have to stumble along couple times, as do not have Autocad written on my C drive, but is on the D drive. Have to change a few things then to make it work. Am using a Calcomp tablet to load LISP software.

But, did a looky - loo for Del (anything) and as expected, nothing cme up. 'least I know the name of the LISP file to look for now.

Wm.

Just cut and paste the routine chelsea listed above into Notepad and save it as deldup.lsp and you should be good to go.

Just cut and paste the routine chelsea listed above into Notepad and save it as deldup.lsp and you should be good to go.

Tried that already late Wed. night. As expected, it said "Duhh?"

I have to go through and modify it to load from and then read from proper directory. Will be doing that early Thursday morning. Long ago, I created a D drive as the standard autocad files eventially consumed too much space on C drive. I got like 10,000 little Acad files now. Most are very small, but still considering the size of other applications they got moved to D back years ago. Things fit, but most LISP files are written assuming the operator still has Acad on C drive. I got to modify first before saying anything further. Then, see what it does. Got four files with too many lines counted up already awaiting here.

Wm.

Once you have loaded the LISP routine I don't think it much cares where your acad.exe file is located or the drawing files either. The routine may be bombing out for other reasons.

Once you have loaded the LISP routine I don't think it much cares where your acad.exe file is located or the drawing files either. The routine may be bombing out for other reasons.

It may with my version.

Back several years ago, for try out purposes on some then new LISP program, I tried tying over the looking for... section within some LISP software. It looked and looked causing a delay or not finding what so ever. (Found it yesterday why not today then?)

Since then I have moved all useable LISP programs over into the Autocad.exe directory and they fired off near immediately. This may accept a link over, but an altered copy will get moved over to speed things up.

Wm.

Version is AutoCAD r14 right?

How do you load your LISP routines, one at a time or en mass?

Mark....

It DUP worked only once. Now getting error messages.

Wm.