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