AutoLISP For Deleting Duplicates 1

[crystalrae]

I have a drawing that is huge. This drawing came from another company and we are now maintaining it. The problem I have is that there seems to be thousands of duplicates on it. For example - there is a rectangle used to represent a sign - if you erase it you actually erase three or four of them. They are just piled on top of each other. I need to find a LISP that will allow me to select a group of enities and have any duplicates deleted. If anyone knows where I can find a program that will do this please let me know. I am running AutoCAD 14. Thanks!

 

[tigrek]

;Command NODUPLICITY
;deletes duplicate copies of
;"LINE,LWPOLYLINE,CIRCLE,ARC,ELLIPSE,SPLINE" elements in the drawing.
;POLYGONE, RECTANG AND PLINE are implictly included, being LWPOLYLINE type
;SELECT OBJECTS by any or all methods combined as usual, when prompted.
;I included BLOCKS in the last minutes.
;If 'has attributes', will be left in peace, even if duplicate.
;on request we may include a function to parse through the attributes
;and delete if all in all duplicate. This is pending
;I wrote this code today for you, so, I would appreciate DEBUG feedback
;and of course ideas to - simplify the code, and - to extend the functionality.

;tigrek@hotpop.com
;

http://www.homescript.com

(defun C:NoDublicity()
(setq SUZY (ssget '((0 . "LINE,LWPOLYLINE,CIRCLE,ARC,ELLIPSE,SPLINE,INSERT&quot)))
(setq LENSUZY (sslength SUZY))
(setq COUNTER 0)

(setq SSLINE (ssadd))
(setq SSLWPOLYLINE (ssadd))
(setq SSCIRCLE (ssadd))
(setq SSARC (ssadd))
(setq SSELLIPSE (ssadd))
(setq SSSPLINE (ssadd))
(setq SSINSERT (ssadd))

(while (setq EDNA (ssname SUZY COUNTER))
(setq ED (entget EDNA))
(cond
((= (dxf 0 ED) "LINE&quot (ssadd EDNA SSLINE))
((= (dxf 0 ED) "LWPOLYLINE&quot (ssadd EDNA SSLWPOLYLINE))
((= (dxf 0 ED) "CIRCLE&quot (ssadd EDNA SSCIRCLE))
((= (dxf 0 ED) "ARC&quot (ssadd EDNA SSARC))
((= (dxf 0 ED) "ELLIPSE&quot (ssadd EDNA SSELLIPSE))
((= (dxf 0 ED) "SPLINE&quot (ssadd EDNA SSSPLINE))
((= (dxf 0 ED) "INSERT&quot (if (not (ASSOC 66 ED))
(ssadd EDNA SSINSERT)
)
)
(t nil)
);END cond
(setq COUNTER (+ 1 COUNTER))
);END while

;GET THE FIRST LINE
;COMPARE TO LINES ONLY - IF ED LIST IDENTICAL, DELETE ONE OF THEM
(setq SSWHICH SSLINE) (purgeType)
(setq SSWHICH SSLWPOLYLINE) (purgeType)
(setq SSWHICH SSCIRCLE) (purgeType)
(setq SSWHICH SSARC) (purgeType)
(setq SSWHICH SSELLIPSE) (purgeType)
(setq SSWHICH SSSPLINE) (purgeType)
(setq SSWHICH SSINSERT) (purgeType)
)
;----------
(defun dxf (n ed) (cdr (assoc n ed)))
;-----------------
(defun purgeType()
(setq LENGTHSSWHICH (sslength SSWHICH))
;if identical list found, delete the original
(if (> LENGTHSSWHICH 1)
(progn
(setq COUNTER 0)

(while (setq EDNA (ssname SSWHICH COUNTER))
(print)(print "COUNTER &quot(princ COUNTER)
(print (dxf 0 ED))
(setq ED (cddddr (entget EDNA)))
(setq COUNTERNEXT 1)

(while (setq EDNANEXT (ssname SSWHICH (+ COUNTER COUNTERNEXT) ))
(setq NAMY (dxf 0 (entget EDNANEXT)))
(setq EDNEXT (cddddr (entget EDNANEXT)))
;compare lists ED and EDNEXT
;seemed like an involved recursive function would be needed here!
;then suddenly I had this inspiration - in one line of code
;tests if two lists are identical -
;trick is, to put the second list into a dummy list!!!
;and ask if the first list is member of the second list-list.
;what do you think?
(if (member ED (list EDNEXT))
(progn
(print "Duplicate &quot(princ NAMY)
(entdel EDNANEXT)
(ssdel EDNANEXT SSWHICH)
);END progn
(PROGN
(setq COUNTERNEXT (+ 1 COUNTERNEXT))
)
);END if
);END while
;(print ED)
(setq COUNTER (+ 1 COUNTER))
);END while
));END if
(princ)
)
;-----------------

 

[crystalrae]

Thanks so much for the routine!

 

[tigrek]

most welcome.
I debugged on Acad2000 but had in mind Acad14 too.
So, I assume it worked there too.

 

[crystalrae]

I haven't run into any problems with AutoCAD 14 as of yet. If I do I will be sure to let you know.