;-----------------------------------------------------------------------------------;
;                                                                                   ;
;   DELDBL.LSP by Michael Bulatovich May 16th, 2002    www.michaelbulatovich.ca     ;
;                                                                                   ;
;   Makes a selection set of exactly duplicate entities in the drawing.             ;
;   Prompts the user to erase or change the selected items, however it              ;
;   will only affect items in the current space and on unlocked layers,             ;
;   since it uses a command calls to modify the database. No error handler-         ;
;   and no warranties!                                                              ;
;                                                                                   ;
;   Based on DelDub.LSP written by Robert Jacobson 4-10-96                          ;
;   Revised to include fuzz factor and streamlined prompts. 21-11-02                ;
;-----------------------------------------------------------------------------------;



(defun c:deldbl  (/ ss c1 c2 func mode sslen a b x y dbls i flag xcep testb num total setfuzz)
  (if (not firstrun)
    (progn
      (setq fuzz 0.00000001)
      (setq firstrun t)))
  (prompt "Deldbl will only rid you of doubles in the current space and on unlocked layers!")
  (initget  "Select Entire")
  (setq mode (getkword
               "\nSearch for duplicates from among (<S>elected objects / Entire file):"))
  (initget  "Yes No")
  (if (not mode)(setq mode "Select"))
  (setq setfuzz (getkword "\nDo you want to set the fuzz factor? Yes/<No>:"))
  (if (eq setfuzz "Yes")
    (setq fuzz (getreal
		 (strcat "\nSpecify minimum difference in values desired as a real number <"
			 (rtos fuzz 2)
			 ">:"))))  
  (cond ((= mode "Entire") (progn (setq ss (ssget "X"))))
  ((= mode "Select") (progn (setq ss (ssget)))))
  (setq dbls (ssadd))
  (setq xcep (list '-1 2 5 100)) ; list of irrelevant keys
  (SETQ C1 0) ; set the first counter to get the first item
  (SETQ SSLEN (SSLENGTH SS)) ; get the length of the set
  (setq total (itoa sslen))	;make a string of it
  (WHILE (< C1 SSLEN)
    (SETQ A (SSNAME SS c1)) ; get an item
    (SETQ B (ENTGET A))
    (setq num (itoa (+ 1 c1)))
    
    (print  (strcat " Processing number " num " of " total " entities."))
    (setq c2 (1+ c1)) ; start the second counter after the first counter
    (while (< c2 sslen)
      (setq x (ssname ss c2)) ; get the next item to compare
      (setq y (entget x))
      (if(equal(length B)(length y));if the entdata list are the same length
	(progn
      (setq i 0) ; start the item counter
      (while (< i (length b)) ; until you run out of items in b...
        (setq testb (nth i b)) ; get the i'th item in b
        (if (not (member (car testb) xcep)) ;if the item key is not exempted
          (progn ; then...
            (if (or
		  (member testb y); if the item is common to y
		  (equal (cdr testb)(cdr (assoc (car testb)y)) fuzz));or just close enough to equal
              (progn ; ; then...
                (setq flag 1) ; set the flag and...
                (setq i (1+ i))); bump the item counter to check the next item
              (progn (setq flag nil) ; if it is not common reset the flag...
                (setq i (1+ (length b))))); and stop checking other items from y-its pointless) 
            ) ; end progn-then expression
          (setq i (1+ i)) ; if-else item key is exempted bump the counter for next item check
          ) ; end of item test
        ) ; end of item loop - you've checked all the items
      (cond ((= flag 1)
             (progn ; if the flag is still set at the end of it all
               
               
               (ssdel x ss); remove the entity from the set
               (SETQ SSLEN (SSLENGTH SS)); shorten the set length
               (ssadd x dbls))) ; and add the dbl to the dbl sset
            ((= flag nil) (setq c2 (1+ c2))) ; if the flag's not set bump the second counter
            ) ; end of cond - the flag check
      );end of progn
	(setq c2 (1+ c2));if entdata is different, bump the second counter
	);end of list-length if
      ) ; end of second loop
	
    (setq c1 (1+ c1)) ; bump the first counter
    ) ;_ end of the first loop
  (cond ((progn (= (sslength dbls) 1))
         (princ "\nOne double found."))
        ((progn (> (sslength dbls) 1))
         (progn
           (princ (strcat (itoa (sslength dbls)) " doubles found."))))
        ((progn (= (sslength dbls) 0))
         (princ "\nNo doubles found."))) ; end of cond
  (initget  "Erase Change")
  (if (> (sslength dbls) 0) ; if doubles are found...
    (setq func (getkword ; prompt for action
                 "\nWhat do you want to do? Change their properties/<Erase them>:") ;_ end of getkword
          ) ; end of setq
    ) ; end of if
  (cond ((= func "Erase") (command "erase" dbls ""))
	((= func nil) (command "erase" dbls ""))
        ((= func "Change") (command "change" dbls "" ))) ; end of cond
(princ); exit quietly
  ) ;_ end of defun