Looking for Routine to Find Duplicate Text in Dwg

[bob.76343]

I'm looking for a LISP routine to find duplicate text in a ACAD2000 dwg. I need the routine to display the duplicates, not to remove them (or make a list of duplicates found)

thanks
bob

[peter]

Here is one I wrote 5 years ago. I could problably write it better now but don't have the time right now.

Hope it works for you.

Peter Jamtgaard



;********************************OVERLAP.LSP**********************************
; Written By : Peter Jamtgaard copr 1999 all rights reserved
; Purpose<OL>: Locate overlapping text
;*****************************************************************************
(defun C:OL (/ ANG B C D DED DENT DSTRING DXLOC DYLOC DANG
ENT TYPE1 INSP XLOC YLOC STRING SSET SSET2)
(setq SSET2 nil)
(setq SSET (ssget (list (cons 0 "TEXT"))))
; (setq SSET (ssget))
(setq B 0 C 0 D 0)
(while (= B 0)
(setq ENT (ssname SSET C))
(if (= ENT nil)(setq B 1)
(progn
(setq ED (entget ENT))
(setq TYPE1 (cdr (assoc 0 ED)))
(if (= TYPE1 "TEXT")
(progn
(setq STRING (cdr (assoc 1 ED)))
(setq INSP (cdr (assoc 10 ED)))
(setq XLOC (car INSP))
(setq YLOC (car (cdr INSP)))
(setq ANG (cdr (assoc 50 ED)))
(setq DENT (ssname SSET D))
(if (= DENT nil)
(setq B 1)
(progn
(setq DED (entget DENT))
(setq DSTRING (cdr (assoc 1 DED)))
(setq DINSP (cdr (assoc 10 DED)))
(setq DXLOC (car DINSP))
(setq DYLOC (car (cdr DINSP)))
(setq DANG (cdr (assoc 50 DED)))
(if (= D C)
(setq E 1)
(if (= ANG DANG)
(if (and (= XLOC DXLOC)(= YLOC DYLOC))
(if (= STRING DSTRING)
(progn
(princ "*")
(if (= SSET2 nil)
(progn
(setq SSET2 (ssadd DENT))
(setq SSET (ssdel DENT SSET))
(setq D (- D 1))
)
(progn
(setq SSET2 (ssadd DENT SSET2))
(setq SSET (ssdel DENT SSET))
(setq D (- D 1))
)
)
)
)
)
)
)
)
)
)
)
(if (= D (- (sslength SSET) 1))
(setq D C C (+ C 1))
(setq D (+ D 1))
)
(if (= C (- (sslength SSET) 1))
(setq B 1)
)
)
)
)
(command "select" sset2)
)

[bob.76343]

Actually I'm looking for a routine to find duplicate text entries in a dwg. For example is I have the following text entries:

220
220F
340
room 1
255B
220F
room 1

I need the routine to identify (and highlight/change color) 220F and room 1 in this example

Any help is highly appreciated
Thank you
bob

[mjfarrell]

Try the FIND tool it is made just for this task
or even use QSELECT to find the specified value.

[thomas.stright]

Try the FIND tool it is made just for this task
or even use QSELECT to find the specified value.
That would be painfully slow....

I think he wants it automated....Wish I knew more a lisp

[mjfarrell]

Automated....Like a whole list of known duplicates
with a list of corresponding replacement words?
Gadzookies....

Or Automated, Like say partial open all the drawings
if multiples are involved, open only the layers the duplicates
live on, and then use FIND to find and replace throughout
all of the partially opened files?

I continue with the FIND suggestion, as it has a nice
context box, that would allow for some logic to prevail
in finding and replacing en mass.
Additionally the find looks for these same values, in attributes,
text, hyperlinks, and a few others that make it particularly
robust.

[BCrouse]

Here is one I wrote 5 years ago. I could problably write it better now but don't have the time right now.

Hope it works for you.

Peter Jamtgaard



;********************************OVERLAP.LSP**********************************
; Written By : Peter Jamtgaard copr 1999 all rights reserved
; Purpose<OL>: Locate overlapping text
;*****************************************************************************
(defun C:OL (/ ANG B C D DED DENT DSTRING DXLOC DYLOC DANG
ENT TYPE1 INSP XLOC YLOC STRING SSET SSET2)
(setq SSET2 nil)
(setq SSET (ssget (list (cons 0 "TEXT"))))
; (setq SSET (ssget))
(setq B 0 C 0 D 0)
(while (= B 0)
(setq ENT (ssname SSET C))
(if (= ENT nil)(setq B 1)
(progn
(setq ED (entget ENT))
(setq TYPE1 (cdr (assoc 0 ED)))
(if (= TYPE1 "TEXT")
(progn
(setq STRING (cdr (assoc 1 ED)))
(setq INSP (cdr (assoc 10 ED)))
(setq XLOC (car INSP))
(setq YLOC (car (cdr INSP)))
(setq ANG (cdr (assoc 50 ED)))
(setq DENT (ssname SSET D))
(if (= DENT nil)
(setq B 1)
(progn
(setq DED (entget DENT))
(setq DSTRING (cdr (assoc 1 DED)))
(setq DINSP (cdr (assoc 10 DED)))
(setq DXLOC (car DINSP))
(setq DYLOC (car (cdr DINSP)))
(setq DANG (cdr (assoc 50 DED)))
(if (= D C)
(setq E 1)
(if (= ANG DANG)
(if (and (= XLOC DXLOC)(= YLOC DYLOC))
(if (= STRING DSTRING)
(progn
(princ "*")
(if (= SSET2 nil)
(progn
(setq SSET2 (ssadd DENT))
(setq SSET (ssdel DENT SSET))
(setq D (- D 1))
)
(progn
(setq SSET2 (ssadd DENT SSET2))
(setq SSET (ssdel DENT SSET))
(setq D (- D 1))
)
)
)
)
)
)
)
)
)
)
)
(if (= D (- (sslength SSET) 1))
(setq D C C (+ C 1))
(setq D (+ D 1))
)
(if (= C (- (sslength SSET) 1))
(setq B 1)
)
)
)
)
(command "select" sset2)
)




Peter,

I tested this lisp and it did not work for me. I selected objects that were stacked and nothing happened. After I selected the objects I got this (**nil).

Thank you,

[kennet.sjoberg]

Hi bob, here is a masterpiece 4U.

code/file FindWord.lsp start here :


;;;
;;; 04-10-04 Find words and point them out from a user defined *WheelHub*
;;; Created by kennet : ) Happy Computing !
;;; Possibility to set a new *WheelHub* when pressing [Esc]
;;; In case off "Grid too dense to display" GRID is set to OFF (grdraw fails)
(defun c:FindWord (/ OldErr Word SelSet Number Counter Got Pkt1) ;; *WheelHub*

;;; Errorhandler
(defun FindWord_Err (msg)
(command "._undo" "_end" )
(command "._undo" "_back" )
(setq *WheelHub* nil )
(setq *error* OldErr )
(princ)
)
;;;--- MAIN ---
(setq OldErr *error* *error* FindWord_Err )
(command "._undo" "_mark" )
(setvar "OSMODE" 0 )
(command "._GRID" "OFF" )
(command "._UCS" "World" )
(command "._UCSICON" "OFF" )
(if (= *WheelHub* nil) (setq *WheelHub* (getpoint "Point out a wheel hub : " )) ( ) )
(setq Word (getstring T "Enter exact text (space included) to find, then [Enter] : " ) )
(if (setq SelSet (ssget "X" '((0 . "TEXT"))) )
(progn
(setq Number (sslength SelSet ) )
(setq Counter 0 Got 0 )
(while (< Counter Number )
(if (vl-string-search Word (cdr (assoc 1 (entget (ssname SelSet Counter )))) )
(if (= (strlen Word ) (strlen (cdr (assoc 1 (entget (ssname SelSet Counter ))))) )
(progn
(setq Pkt1 (cdr (assoc 10 (entget (ssname SelSet Counter )))) )
(grdraw *WheelHub* Pkt1 3 0 )
(setq Got (1+ Got ) )
(setq Counter (1+ Counter ) ) ;; Word is OK
)
(setq Counter (1+ Counter ) ) ;; WordLength is not exact
)
(setq Counter (1+ Counter ) ) ;; Word is not in textstring
)
)
(princ "\nCommand: FindWord [Esc] to change WheelHub." )
(princ "\nCommand: pan, zoom, repaint and... to clear vectors.\n" )
(princ (strcat (itoa Got) " number of " Word " found ! " ) )
)
(princ "No simple text found in this drawing, no support for MTEXT or DIMENSION." )
)
(command "._undo" "_end" )
(command "._undo" "_back" )
(setq *error* OldErr )
(princ)
) ;; end defun c:FindWord

[peter]

The post I made earlier was for overlapping text. It actually returned a selection set of the overlapping text, so you could delete them if you wanted.


For your duplicate text problem...

I though you wanted to find text on text but as I understand now you want to find text that has the same text strings.

Peter Jamtgaard



(defun C:Duplicates (/ intCount entSelection lstEntities ssSelections ssSelections2)
(setq ssSelections (ssget (list (cons 0 "TEXT"))))
(repeat (setq intCount (sslength ssSelections))
(setq intCount (1- intCount)
entSelection (ssname ssSelections intCOunt)
lstEntities (cons entSelection lstEntities)
)
)
(repeat (setq intCount (sslength ssSelections))
(setq intCount (1- intCount)
entSelection (ssname ssSelections intCOunt)
lstEntities (vl-remove entSelection lstEntities)
)
(if (member (vla-get-textstring
(vlax-ename->vla-object entSelection)
)
(mapcar '(lambda (x)(vla-get-textstring
(vlax-ename->vla-object X)
)
)
lstEntities
)
)
(if ssSelections2
(setq ssSelections2 (ssadd entSelection ssSelections2))
(setq ssSelections2 (ssadd entSelection))
)
)
(print (sslength ssSelections2))
)
(repeat (setq intCount (sslength ssSelections2))
(setq intCount (1- intCOunt)
entSelection (ssname ssSelections2 intCount)
)
(print (vla-get-textstring
(vlax-ename->vla-object
entSelection
)
)
)
)
(vl-cmdf "Select" ssSelections2 "")
(princ)
ssSelections2
)

[bob.76343]

I tried all the routines posted, none worked. The best worked Find.lsp that was suggested. THe only problem is that Find is manual so I have to enter the search query manually.

I usually have hundreds of labels (like room numbers, etc) in a dwg so entering each of them manualy will take forever.

I basically need the Find routine to be modified to automatically check all text in a dwg

Anybody can help with that?

Attached to this posting is the actual Find.lsp routine

Thank you all

bob

[kennet.sjoberg]

Hi again bob !

"Actually I'm looking for a routine to find duplicate text entries in a dwg. For example is I have the following text entries:"

220
220F
340
room 1
255B
220F
room 1

Copy and paste Your example text above in to AutoCADs Graphics window
Explode Your newly pasted MTEXT to TEXT
copy and spread them out all over.

"I need the routine to identify (and highlight/change color) 220F and room 1 in this example"

Load FINDWORD, or copy and paste the code from
(defun c:FindWord (/ . . . .
to
) ;; end defun c:FindWord
in to AutoCADs Command window

Run FINDWORD
Command: FINDWORD
Point out a wheel hub : pick a point anywhere on the screen inside AutoCADs Graphics window
"Enter exact text (space included) to find, then [Enter] : " Type 220F or room 1 and press Enter

FINDWORD will draw green vectors on the screen, from the WheelHub to all text that are identical,
like : "room 1" == "room 1"
but not "room 1" inside the text string "my room is beside room 1 beside room..."

For me it works exactly like You asked for,
do You want to reformulate Your question ?

: ) Happy Computing !

kennet

[bob.76343]

Hi Ken

Thanks for the reply. Yes FindWord works just like you stated, but I need a routine that atuomatically searches a dwg w/out an input search string. Plus if I have 200 duplicates in the dwg, FIndWord will draw 200 lines that will make the dwg very hard to read:)

Thanks

bob

[kennet.sjoberg]

hmmm... bob

"but I need a routine that atuomatically searches a dwg w/out an input search string"
Sorry I do not understand. ( .se )

"FIndWord will draw 200 lines.." <== it is not lines it is pixels on the screen that disappears when You pan or zoom or repaint or . . .

"...that will make the dwg very hard to read" <== it depends on the zoom factor and the wheelhub.

The routine can be modified, but I do not understand Your needs.
Can anybody try to clarify ?

: ) Happy Computing !

kennet

[bob.76343]

I really need to get this working. I have a huge amount of text in every dwg that I need to check for duplicates. Can anybody help?
Even if I have to pay for a routine, anybody knows any commercial product that can do this?
thanks

bob

[whdjr]

What type of text entities are we talking about?
ie.:dtext, mtext, attributes, dimensions, etc.

If you can give it a phrase to search for I have a routine that will tell you how many strings it finds for dtext, mtext, and attributes.

interested?

[kennet.sjoberg]

but what are you trying do do bob ?
find and replace ? insert something ? delete ? or ..?

to find duplicates is the minor problem, but then ?

: ) Happy Computing !

kennet

[whdjr]

Can you post a drawing with an example of the text?

[peter]

Maybe I wasn't understanding what you were looking for. The duplicates will look for duplicate text and write them to the screen.

I found an error in the duplicates routine so I am reposting it. It will create a selection set of duplicate text strings in a drawing. It returns a selection set.

Peter Jamtgaard





(defun C:Duplicates (/ intCount entSelection lstEntities ssSelections ssSelections2)
(setq ssSelections (ssget (list (cons 0 "TEXT"))))
(repeat (setq intCount (sslength ssSelections))
(setq intCount (1- intCount)
entSelection (ssname ssSelections intCOunt)
lstEntities (cons entSelection lstEntities)
)
)
(repeat (setq intCount (sslength ssSelections))
(setq intCount (1- intCount)
entSelection (ssname ssSelections intCOunt)
lstEntities (vl-remove entSelection lstEntities)
)
(setq lst lstEntities)
(if (member (vla-get-textstring
(vlax-ename->vla-object entSelection)
)
(mapcar '(lambda (x)(vla-get-textstring
(vlax-ename->vla-object X)
)
)
lstEntities
)
)
(progn
(print ssSelections2)
(if ssSelections2
(setq ssSelections2 (ssadd entSelection ssSelections2))
(setq ssSelections2 (ssadd entSelection))
)
)
)
)
(vl-cmdf "Select" ssSelections2 "")
(princ)
ssSelections2
)

[kennet.sjoberg]

Hi again bob, I have reread the tread over and over, and now i think I do understand your needs, pure and simple as :
"I'm looking for a LISP routine to find duplicate text in a ACAD2000 dwg. I need the routine to display the duplicates, not to remove them (or make a list of duplicates found)"

CountDup count and display the duplicates to the screen, probably what You are looking for.



;;;
;;; 04-10-16 CountDup Find equal words, count and print them to the screen
;;; Created by kennet : ) Happy Computing !
;;;
(defun c:CountDup ( / SelSet Counter TxtLstFull TxtLstNames TxtLst-Single TxtLstNames-Single IndexS Txt IndexF )
(if (setq SelSet (ssget "X" '((0 . "TEXT"))) )
(progn
(setq Counter 0 )
(repeat (sslength SelSet )
(setq TxtLstFull (append TxtLstFull (list (cdr (assoc 1 (entget (ssname SelSet Counter )))))) ) ;; make a list with all text
(if (not (member (cdr (assoc 1 (entget (ssname SelSet Counter )))) TxtLstNames ))
(setq TxtLstNames (append TxtLstNames (list (cdr (assoc 1 (entget (ssname SelSet Counter ))))))) ;; make a list without duplicates
( )
)
(setq Counter (1+ Counter ) )
)

(setq TxtLst-Single TxtLstFull ) ;; "TxtLst minus Single"
(setq TxtLstNames-Single TxtLstNames ) ;; "TxtLstNames minus Single"
(setq Counter 0 IndexS 0 )
(repeat (length TxtLstNames )
(setq Txt (nth IndexS TxtLstNames ) )
(setq IndexF 0 )
(repeat (length TxtLstFull )
(if (= Txt (nth IndexF TxtLstFull )) (setq Counter (1+ Counter )) ( ) )
(setq IndexF (1+ IndexF ) )
)
(if (= Counter 1 ) (setq TxtLst-Single (vl-remove Txt TxtLst-Single )) ( ) ) ;; Subtract all Singles
(if (= Counter 1 ) (setq TxtLstNames-Single (vl-remove Txt TxtLstNames-Single )) ( ) ) ;; Subtract all Singles
(setq Counter 0 )
(setq IndexS (1+ IndexS ) )
)

;;; Count how many SingleNames inside TxtLst-Single
(setq Counter 0 IndexS 0 )
(repeat (length TxtLstNames-Single )
(setq Txt (nth IndexS TxtLstNames-Single ) )
(setq IndexF 0 )
(repeat (length TxtLst-Single )
(if (= Txt (nth IndexF TxtLst-Single )) (setq Counter (1+ Counter )) ( ) )
(setq IndexF (1+ IndexF ) )
)
(princ "\nThere is : " ) ;; print the result/number for each of them
(princ (strcat (itoa Counter ) " " Txt " in the drawing." ) )
(setq Counter 0 )
(setq IndexS (1+ IndexS ) )
)
(princ "\nSingle text is not shown, no support for MTEXT or DIMENSION." )
)
(princ "No simple text found in this drawing. No support for MTEXT or DIMENSION." )
)
(princ)
)


: ) Happy Computing !

kennet

[peter]

Try this revised version of the duplicates program I posted above. It seems to have had a minor problem but works fine for me now

Peter Jamtgaard



(defun C:Duplicates (/ intCount entSelection lstEntities ssSelections
ssSelections2)
(setq ssSelections (ssget (list (cons 0 "TEXT"))))
(repeat (setq intCount (sslength ssSelections))
(setq intCount (1- intCount)
entSelection (ssname ssSelections intCOunt)
lstEntities (cons entSelection lstEntities)
)
)
(repeat (setq intCount (sslength ssSelections))
(setq intCount (1- intCount)
entSelection (ssname ssSelections intCOunt)
lstEntities (vl-remove entSelection lstEntities)
)
(setq lst lstEntities)
(if (member (vla-get-textstring
(vlax-ename->vla-object entSelection)
)
(mapcar '(lambda (x)(vla-get-textstring
(vlax-ename->vla-object X)
)
)
lstEntities
)
)
(progn
(print ssSelections2)
(if ssSelections2
(setq ssSelections2 (ssadd entSelection ssSelections2))
(setq ssSelections2 (ssadd entSelection))
)
)
)
)
(vl-cmdf "Select" ssSelections2 "")
(princ)
ssSelections2
)

[kennet.sjoberg]

hooo hooo.... bob, are You there ?

please response abut CountDup

: ) Happy Computing !

kennet