Jump to content
Cidona

Removing Duplicate Text

Recommended Posts

Cidona

Dear Forum.

Would appreciate any advise in the following regards...

I need to xref in a bunch of xrefs which I'm then binding and then bursting. When I do this, there is a lot of overlapping items. I am able to use "Overkill" which removes all the overlapping lines, etc. which is great (doing this command is removing approx 30,000 duplicates). However, the Overkill command isn't working on the text so I'm left with a lot of overlapping text.

(BTW, I’ve DWGs I’ve received are exports from the software the Architect & Engineers are using (which isn’t AutoCAD), which is why I’m dealing with Xrefs with so many overlapping items…)

I did a bit of Googling and say some people on some old threads were saying that Overkill was working on text for them. I did a quick test (new drawing, Dtext>"Test", Copybase 0,0,0, selected the text, Paste @ 0,0,0. This gave me two text right onto of each other. I then did Overkill and sure enough it got rid of the duplicate.

I’m wondering why it’s not working with the text in these files I’ve received.

Please see attached where I have copied one instance of where this is happening and pasted into another drawing. Anyone have any suggestions?

Duplicate Text.dwg

Thank you.

Edited by Cidona
Forgot to add attachment

Share this post


Link to post
Share on other sites
BIGAL

Found this

 

Note I changed one line for your dwg ;(setq obj (list pt lay ang sty hgt str)) I have removed some of the options the most common one is probably the layer is different with your text. It makes sense to add some compare yes / no to the tests so could leave some behind.

 

;;;-------------------------------------------------------------------------

;;;
;;; DEL_TXT.LSP
;;;
;;; (C) Copyright 1999 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;; July 1996
;;;
;;;-------------------------------------------------------------------------

;;;
;;; DESCRIPTION
;;;
;;; This function deletes duplicate text objects.
;;; A duplicate object is defined as
;;; -the same location
;;; -the same layer
;;; -the same rotation angle
;;; -the same text style
;;; -the same text height
;;; -the same text string
;;;-------------------------------------------------------------------------

;;;*************************************************************************

;;;

(defun c:deldup_txt( / ss ssdup ct len e eb
pt lay ang sty hgt str obj obj_list)

(princ "\nSelect text objects.") ;Select objects and filter all but block insert objects.
(setq ss (ssget (list (cons 0 "TEXT"))))
(if ss ;If any valid objects were selected.
(progn
(princ "\nBuilding list of objects.")
(setq ssdup (ssadd)) ;Initialize new selection set to hold objects to delete
(setq len (sslength ss)) ;Find out how many objects were selected.
(setq ct 0)
(while (< ct len) ;Loop through selected objects
(setq e (ssname ss ct)) ;Get an object name
(setq eb (entget e)) ;Get the entity list from the object name
(setq ct (+ ct 1)) ;Increment index into selection set
(setq pt (cdr (assoc 10 eb))) ;Access object's coordinate
(setq lay (cdr (assoc 8 eb))) ;Access object's layer
(setq ang (cdr (assoc 50 eb))) ;Access object's rotation angle
(setq sty (cdr (assoc 7 eb))) ;Access object's text style
(setq hgt (cdr (assoc 40 eb))) ;Access object's text height
(setq str (cdr (assoc 1 eb))) ;Access object's text string
;Make list of object properties

;(setq obj (list pt lay ang sty hgt str))
(setq obj (list pt str))
(if (not (member obj obj_list)) ;If these properties are not already in list
(setq obj_list (cons obj obj_list)) ;Add them to the list
(ssadd e ssdup) ;Else add object to selection set to delete
) ;End if
) ;End of while loop

(if (> (sslength ssdup) 0) ;If there are any objects in the selection set to delete
(progn
(princ "\nDeleting duplicate objects.")
(setq len (sslength ssdup)) ;Find out how many many objects to delete.
(setq ct 0)
(while (< ct len) ;Loop through objects and delete.
(setq e (ssname ssdup ct)) ;Get object name
(setq ct (+ ct 1)) ;Increment index into selection set
(entdel e) ;Delete duplicate object
) ;End of while loop

;Print the number of objects deleted to command line
(princ (strcat "\nDeleted " (itoa len) " duplicate objects." ))
) ;End progn
(princ "\nNo duplicates found.") ;Else no there were no duplicates to delete.
) ;End if

) ;End progn
(princ "\nNo text objects selected.") ;Else there were no valid objects selected
) ;End if
(princ)
)

Edited by BIGAL

Share this post


Link to post
Share on other sites
Cidona

BIGAL, you are my super hero!! :)

 

That worked a treat! Removed another 10,000+ duplicates and that's just one floor. Would have taken me a while to remove the duplicates manually :).

 

Great start to my day. Thank you VERY much!!

 

Best Regards.

Share this post


Link to post
Share on other sites
BIGAL

No thank Google after all the code is from 1996.

Share this post


Link to post
Share on other sites
Cidona

Well it was a big help for me so I'm thanking you ;).

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×