Pre-defined find & replace lisp for text, mtext and attribute text.

[Anonymous]

Hi,

Is there any lisp for predefined  find and replace for text, mtext and attribute text?. I found a lisp here but it is not replacing attribute text.

(defun C:TRC ; = Text Replace for Complete text/mtext strings, pre-defined content
  (/ tss tdata)
  (setq tss (ssget "X" (list (cons 1 "issued for tender"))))
  (repeat (sslength tss)
    (setq
      tdata (entget (ssname tss 0))
      tdata (subst (cons 1 "issued for construction") (assoc 1 tdata) tdata)
    ); end setq
    (entmod tdata)
    (ssdel (ssname tss 0) tss)
  ); end repeat
); end defun

[dbroad · Accepted solution]

This is a scaffold for the process using ActiveX assuming you are capable of programming.  If not, then learn how.

(vl-load-com)
;;scaffold for string substitution in objects
(defun c:test (/ on os ns ts atts)
  ;;add prompts here to ask for search and new strings
  ;;add prompts for objectname filtering.
  ;;fixed case for testing
  (setq os "issued for tender" ;old string
	ns "issued for construction";new string
	osp (strcat "*" os "*");search string pattern
	)
  ;;processes every block in document
  (vlax-for blk	(vla-get-blocks
		  (vla-get-activedocument (vlax-get-acad-object))
		)
    ;;processes every item in block blk
    (vlax-for itm blk
      (setq on (vla-get-objectname itm))
      (cond ((member on '("AcDbText" "AcDbMtext" ;|other text based object names here|;))
	     (setq ts (vla-get-textstring itm))
	     (if (wcmatch ts osp)
	       (vla-put-textstring
		 itm
		 (vl-string-subst ns os ts)
	       )
	     )
	    )
	    ((= on "AcDbBlockReference")
	     (setq atts (vlax-invoke itm 'getattributes))
	     (foreach n atts
	       (setq ts (vla-get-textstring n))
	       (if (wcmatch ts osp)
	       (vla-put-textstring
		 n
		 (vl-string-subst ns os ts)
	       )
	     )
	     )
	     ;;put code here for constant attributes
	     )
	    
	    ;;other objectname conditions go here
	    (t
	     ;;default objectname condition goes here
	    )
      )
    )
  )
  (princ)
)

[john.uhden]

Very clever. YOU know that the blocks collection includes ModelSpace, but how about PaperSpace layouts? I'm asking 'cause I don't know and am too lazy to look it up.

Yeah, I know that all his texts and attributes are most likely in ModelSpace, but like the lottery, "Hey, ya never know."

Just a thought, would (ssget "X" '((1 . "*"))) get all the text/mtext objects in the drawing? And then how about (ssget "X" '((0 . "INSERT")(66 . 1))) for block references with attributes?

[Kent1Cooper]

---

@john.uhden wrote:
...
Just a thought, would (ssget "X" '((1 . "*"))) get all the text/mtext objects in the drawing? ....

---

...

Yes, and also all Dimensions, since they have a 1-code entry for text override [even if using the non-overridden measured length/angle -- (1 . "")].

[john.uhden]

Okay, then (ssget "X" '((0 . "*TEXT"))) though there may be some custom
text-like objects as well, like maybe C3D ArcText if they expose DXF codes
for filtering. Then again, messing with MText strings is kinda like
translating encrypted ciphers. I can UNFORMAT them, but putting them back
together is another story.

[dbroad]

Thanks @Kent1Cooper. You beat me to it.  Yes it includes block definitions, layout blocks, model space block, anonymous blocks, and dimension blocks.  I did not add logic for textoverrides for dimensions. I left room for that kind of stuff.  The find command does all of that with very little fuss so I really have no need for custom solutions.  Doing these programs, however, sure shakes the cobwebs out of the brain.

A legacy method using a selection set would also work if the selection had an <or filter in it to look for blocks as well.  Then looping through the selection set, it could process the attributes of the block.  The problem with SSGET is that it won't return attributes.

Thanks for looking John.

[john.uhden]

I asked about paperspace blocks.

[dbroad]

Layout blocks are paper space blocks. The most recent non-model tab is the *paperspace block. Other layout tab blocks are *paperspace#. In an empty drawing, there are usually at least three blocks:
*Model_Space
*Paper_Space
*Paper_Space0

(vlax-for blk 
  (vla-get-blocks
    (vla-get-activedocument
        (vlax-get-acad-object)))
  (princ "\n")
  (princ (vla-get-name blk)))

[Anonymous]

Its working...

Thank you Mr. dbroad.

[patrick_35]

Hi

Just a tip, rather than test the type of object

(member on '("AcDbText" "AcDbMtext" ;|other text based object names here|;))

You can see if they have the text string property

(vlax-property-available-p itm 'textstring)

@+

[dbroad]

Good point @patrick_35.  That would be easier and cast the net wider.

@Anonymous:  Glad to help.

[Kent1Cooper]

---

@patrick_35 wrote:

....

You can see if they have the text string property

(vlax-property-available-p itm 'textstring)

@Anonymous wrote:

Good point @patrick_35.  That would be easier and cast the net wider.

....

---

... or cast it narrower, depending on what you're after.  In the case of Dimensions [no, they're not in the Subject line or original question, but they have been brought into the discussion], what is in the (1 . "whatever") entry in entity data, when looked at in VLA Properties, is called 'TextOverride, rather than 'TextString, so the above check would miss those.

[dbroad]

@Kent1Cooper:  You could add that as the second COND test.

[Anonymous]

So, I've found several codes that are close to what I'm looking for, but not close enough. I don't have the knowledge to edit a LISP to fit my needs, so I need help. 

My company has a Predefined Find and Replace command for attributes, which i would like to expand upon to Find and Replace Text, and Mtext within a drawing. also perhaps Text and Mtext within blocks. What my company has so far is this:

(defun c:FAR ()

(vl-load-com)


(defun attreplace (old new / aval)
  (vlax-for n
	    (vla-get-blocks
	      (vla-get-activedocument
		(vlax-get-acad-object)))
    (vlax-for m n
    (if (and (= "AcDbBlockReference" (vla-get-objectname m))
	     (= :vlax-true (vla-get-hasattributes m)))
	(foreach a
		 (vlax-invoke m  'getattributes)
	  (setq aval (vla-get-textstring a))
	  (while (vl-string-search old aval) ;;<- look for string
	   (setq aval (vl-string-subst new old aval )) ;;<-replace here
	    )
	  (vla-put-textstring a aval)
	  )
      ))
      ))
		(attreplace "TECHNOLOGIES" "TECH")
		(attreplace "COMMUNICATION COMPONENTS INC." "COMM COMPONENTS")
		(attreplace "DUAL BAND" "DB")
		(attreplace "Remote Radio Head" "Rem Radio Hd")
		(attreplace "Other - With RF" "Other-W/ RF")
		(attreplace "Other - Without RF" "Other-W/O RF")
		(attreplace "SAMSUNG TELECOMMUNICATIONS" "SAMSUNG TELECOM")
		(attreplace "COMMUNICATIONS" "COMM")
		(attreplace "COMMUNICATION" "COMM")
		(attreplace "TECHNOLOGY" "TECH")
		(attreplace "FULL BAND" "FB")
		(attreplace "MASTHEAD" "MSTHD")
		(attreplace "DUAL DUPLEX" "DD")

		(princ)
	  )

The obvious list of things to change and what to change them to i LOVE. Makes it easy on any of us to add a new thing we find along the way that needs updated text wise. But, as you can see this only works for attributes. Is there a way to edit this to also find mtext and text, within or not within a block? Would i need separate lists for each type of text i was changing? Or can i have one easy to read/change list of things to find and replace that goes for all types of text?

Keep in mind these will not be complete text entities. everything will be stuff found within a larger note

(EX. (134'-0" S.S. TOWER) would need changed to (134'-0" SS TOWER) so id be looking jsut to change S.S. to SS)

Thanks in advance to anyone who is able to help me out. 

[john.uhden]

I think these functions cover most things, including dimensions.

NOTICE that I did place New ahead of Old, but you can switch them if you want.

So, if you want to replace all "S.S." with "SS" then (replaceall "SS" "S.S.")

(defun replacestr (Obj new old / str)
   (foreach Property '(TextString TextOverride)
     (and
       (vlax-property-available-p Obj Property)
       (setq str (vlax-get Obj Property))
       (while (vl-string-search old str) ;;<- look for string
          (setq str (vl-string-subst new old str )) ;;<-replace here
          (vlax-put Obj Property str)
       )
     )
  )
)

(defun replaceall (new  old)
   (vlax-for n
 	    (vla-get-blocks
 	      (vla-get-activedocument
 		(vlax-get-acad-object)))
     (vlax-for m n
       (if (and  (= "AcDbBlockReference" (vla-get-objectname m))
 	     (= :vlax-true (vla-get-hasattributes m)))
          (foreach att (vlax-invoke m  'getattributes)
             (replacestr att new old)
          )
          (replacestr m new old)
       )
     )
   )
 )
         

[Anonymous]

I apologize if this is a stupid question, i am extremely new to coding and have had no luck goofing around with this code according to your advice. I'll attach what i have. I want this to only look for text and mtext strings. Does this code cover if the string is not complete as well? 

For example "180 FT SELF SUPPORT TOWER" I just need to to replace "SELF SUPPORT" within that string. 

Again, very sorry I am lacking a lot of knowledge in this area. Just starting to learn. Could you perhaps show me exactly what needs changed to make this work and how to update?

I appreciate the help a TON!! thank you!!

(defun c:FALP ()

(vl-load-com)


(defun txtreplace (old new / aval)
  (vlax-for n
	    (vla-get-blocks
	      (vla-get-activedocument
		(vlax-get-acad-object)))
    (vlax-for m n
    (if (and (= "AcDbText,AcDbMText" (vla-get-objectname m)))
	(foreach a
		 (vlax-invoke m  'getattributes)
	  (setq aval (vla-get-textstring a))
	  (while (vl-string-search old aval) ;;<- look for string
	   (setq aval (vl-string-subst new old aval )) ;;<-replace here
	    )
	  (vla-put-textstring a aval)
	  )
      ))
      ))
		(txtreplace "SELF SUPPORT" "SS")
		(txtreplace "S.S." "SS")
		(txtreplace "TYP." "TYP")

		(princ)
	  )

I've highlighted in red the line i think may be just looking for attributes, am i correct? and if so how to i change it?

[john.uhden]

You should find that this works a little better.

Look down near the bottom to create you actual list of olds and news.

It will do text, mtext, attributes, and dimensions.

(defun c:FALP ( / *error* Doc vars #)
  ;; NOTE that the replacestr and replaceall functions are left global
  (vl-load-com)
  (gc)
  (defun *error* (err)
    (mapcar '(lambda (x)(setvar (car x)(cdr x))) vars)
    (vla-endundomark Doc)
    (cond
      ((not err))
      ((wcmatch (strcase err) "*CANCEL*,*QUIT*"))
      (1  (princ (strcat "\nERROR: " err)))
    )
    (princ)
  )
  (setq Doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq # 0)
  (vla-endundomark Doc)
  (vla-startundomark Doc)
  (setq vars (mapcar '(lambda (x)(cons x (getvar x))) '("cmdecho")))
  (mapcar '(lambda (x)(setvar (car x) 0))  vars)
  (command "_.expert" (getvar "expert")) ;; dummy command

  ;; NOTICE I changed the order of the OLD and NEW arguments
  (defun replacestr (Obj old new / oldstr newstr)
     (foreach Property '(TextString TextOverride)
       (and
         (vlax-property-available-p Obj Property)
         (setq oldstr (vlax-get Obj Property) newstr oldstr)
         (while (vl-string-search old newstr) ;;<- look for string
           (setq newstr (vl-string-subst new old newstr )) ;;<-replace here
           (if # (setq # (1+ #)))
         )
         (/= newstr oldstr)
         (vlax-put Obj Property newstr)
       )
    )
  )

  ;; NOTICE I changed the order of the OLD and NEW arguments
  (defun replaceall (old new)
     (vlax-for n
   	    (vla-get-blocks
   	      (vla-get-activedocument
   		(vlax-get-acad-object)))
       (vlax-for m n
         (if (and  (= "AcDbBlockReference" (vla-get-objectname m))
   	     (= :vlax-true (vla-get-hasattributes m)))
            (foreach att (vlax-invoke m  'getattributes)
               (replacestr att old new)
            )
            (replacestr m old new)
         )
       )
     )
   )

   (setq pairs
     (list
      ;; NOTICE the quoted lists:
       '("SELF SUPPORT" "SS")
       '("S.S." "SS")
       '("TYP." "TYP")
       '("TECHNICAL" "TECH")
     )
   )

   (mapcar '(lambda (x)(apply 'replaceall x)) pairs)
   (if # (princ (strcat "\nReplaced a total of " (itoa #) " occurrences.")))
   (*error* nil)
)

[Footrot]

This works well! Problem is it takes a long time if the list grows long!