Replace all texts strings (in blocks also)

[Anonymous]

I wish to change a specific string of text in my drawings (one drawing at a time) with a substituted string of text.

I want this to act globally on all text in the drawing.

I have a short lisp routine (below) that works well on all text (single line and multiline) in the drawing.

However, it does not work on strings within blocks.

The strings in the blocks are single line and multiline text also (not attributes), yet they are not being found to change them also.

Can anyone provide help in adding to this routine so that it also works on text and multiline text inside blocks.

Below is the lisp I currently use. Note: the "TEXT TO BE FOUND" and the "TEXT TO BE REPLACED" are always static as we are actually just searching the drawing for all instances of a specific name and changing them to a different name.

Also, please know that this will be incorporated into a larger routine that will also change out logos and such; thus, I wish to use a quick lisp routine to doo all the functions.  Otherwise, yes I know, I'd use Find/Replace for this.

(vl-load-com)
(defun c:test1 (/ i obj RegExp ss)
   (if (setq ss (ssget "_X" '((0 . "MTEXT,TEXT"))))
      (progn
         (setq RegExp (vlax-get-or-create-object "VBScript.RegExp"))
         (vlax-put-property RegExp 'Global actrue)
         (vlax-put-property RegExp 'Ignorecase actrue)
         (vlax-put-property RegExp 'Multiline actrue)
         (vlax-put-property RegExp 'Pattern "TEXT TO BE FOUND")
         (repeat (setq i (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
            (if (vlax-write-enabled-p obj)
               (vla-put-textstring obj (vlax-invoke RegExp 'Replace (vla-get-textstring obj) "TEXT TO BE REPLACED"))
            )
         )
         (vlax-release-object RegExp)
      )
   )
   (princ)
)

Thanks for any help you can provide,

Barry Navarre

[Ranjit_Singh]

Many ways to do it. For example below code. Call with arguments (somefunc "New String" "Old String")

(defun somefunc  (new old / ent entdata)
  (mapcar '(lambda (x)
             (cond ((= (cdr (assoc 0 (entget (cadr x)))) "INSERT")
                    (setq ent (tblobjname "block" (cdr (assoc 2 (entget (cadr x))))))
                    (while (and (setq ent (entnext ent))
                                (wcmatch (cdr (assoc 0 (setq entdata (entget ent)))) "TEXT,MTEXT")
                                (test new old entdata))))
                   (T (test new old (entget (cadr x))))))
          (ssnamex (ssget "_x" '((0 . "TEXT,MTEXT,INSERT")))))
  (command "._regen")
  (princ))

(defun test (a b c) (entmod (subst (cons 1 (vl-string-subst a b (cdr (assoc 1 c)))) (assoc 1 c) c)))

[dbroad]

Thanks for posting the regex information.  Hadn't used that before.  Here is another option.

;;call by (replaceall "old text" "new text")
(defun replaceall (old new / regex)
  (setq regex (vlax-get-or-create-object "VBScript.RegExp"))
  (vlax-put-property regex 'global actrue)
  (vlax-put-property regex 'ignorecase actrue)
  (vlax-put-property regex 'multiline actrue)
  (vlax-put-property regex 'pattern old)
  ;;process every block
  (vlax-for n  (vla-get-blocks
			    (vla-get-activedocument
			      (vlax-get-acad-object)
			    )
			  )
    (vlax-for m n
    (if	(member (vla-get-objectname m) '("AcDbMtext" "AcDbText"))
      (vla-put-textstring
	m
	(vlax-invoke
	  regex
	  'replace
	  (vla-get-textstring m)
	  new
	))))))

[jdiala]

Another one, also you can filter the text via ssget so you don't have to iterate on all text and mtext on the drawing

(ssget "_x" '((0 . "*TEXT") (1 . "TEXT_TO_FIND")))

(defun C:test (/ ss i obj tfind rfind doc)
  (setq tfind "FINDTEXT" ;;;replace this value
        rfind "REPLACED TEXT" ;;;replace this value
        doc (vla-get-activedocument (vlax-get-acad-object)))

  (if 
    (setq ss (ssget "_X" 
              (list
                 (-4 . "<OR")
                   (-4 . "<AND") 
                     (0 . "*TEXT") (1 . tfind) 
                   (-4 . "AND>")
                   (-4 . "<AND") 
                     (0 . "INSERT")
                   (-4 . "AND>")
                 (-4 . "OR>") 
               )
             )
     )
     (repeat (setq i (sslength ss))
        (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
        (if 
          (vlax-property-available-p obj 'TextString)
          (vla-put-TextString obj rfind)
          (progn
            (setq b (vla-item (vla-get-blocks doc) (vla-get-Effectivename obj)))
            (vlax-for x b
              (if 
                (and
                  (vlax-property-available-p x 'TextString)
                  (= (vla-get-TextString x) tfind) 
                )
                (vla-put-TextString x rfind)
              )
            )
          )
        )
     )
  )
(vla-regen doc acAllViewports)
)

[dbroad]

JD,

Although I haven't tried your program, I doubt it would meet a couple of criteria implied in the original post: 1)Find nested text (implied with regular expressions) 2)Find a pattern based regular expression based within text entities, 3)Change text within blocks.  The beauty of regular expressions is that they go way beyond wildcard capabilities in intelligent searches.  The OP posted a great solution for situations where selection sets can be used. Unfortunately there is no selection set option that will find objects within block definitions other than model and paper space blocks.  You have to process the block collection and within each block, parse each relevant item within the block definition.  Once you change all the block definitions, you have found and replaced all instances.

[Anonymous]

dbroad,

Thank you for your help.

I however am not familiar enough with the code to be able to incorporate your "process every block" section into my existing routine.

Upon loading the routine (with your addition) I only receive this error: a; error: bad argument type: lselsetp nil

Please see below the new cobbled together routine.

Also know that the old string of text would have a space in it, thus I represent it below as OLDNAME OLDNAME.

I tell you this because I'm not sure if a space must be represented as some special character or stands as is.

;;call by (replaceall "old text" "new text")
(vl-load-com)
(defun replaceall (old new / regex)
  (setq regex (vlax-get-or-create-object "VBScript.RegExp"))
  (vlax-put-property regex 'global actrue)
  (vlax-put-property regex 'ignorecase actrue)
  (vlax-put-property regex 'multiline actrue)
  (vlax-put-property regex 'pattern "OLDNAME OLDNAME")

  ;;process every block
  (vlax-for n  (vla-get-blocks
       (vla-get-activedocument
         (vlax-get-acad-object)
       )
     )
    (vlax-for m n
    (if (member (vla-get-objectname m) '("AcDbMtext" "AcDbText"))
      (vla-put-textstring
 m
 (vlax-invoke
   regex
   'replace
   (vla-get-textstring m)
   new
 ))))))

         (repeat (setq i (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
            (if (vlax-write-enabled-p obj)
               (vla-put-textstring obj (vlax-invoke RegExp 'Replace (vla-get-textstring obj) "NEWNAME"))
            )
         )
         (vlax-release-object RegExp)

      )
   )
   (princ)
)

[dbroad]

Your OP title stated "all texts...in blocks also".  All texts would imply everything in the drawing.  If you want to use a selection which includes blocks, that is an entirely different process.  For that, you would need to process the selection set and for selected blocks, you would need to change the block definition.  I don't have time to rewrite that today but when I get a chance, I will investigate.  Others will probably post solutions by then so keep an eye out.

Before anyone else posts on the topic, please state clearly these new requirements because your additions to my routine do not conform to the goal stated as "I want this to act globally on all text in the drawing."

All you had to do with my function is to call it with 2 arguments, the text pattern to search for and the new text to replace it with.  It would automatically process the whole drawing.  

(replaceall "your pattern to look for"  "your new text")

[Anonymous]

Again thanks for your reply.

Your understanding of the OP is correct, I do want it to act globally to search all text in the drawing, not a selection set.

I did get your routine to run "as-is" by loading the routine and pasting to the command line: (replaceall "MY OLD TEXT" "MY NEW TEXT").

This successfully changed all instances of the old single line text, even within the blocks, as I need.

However, now all multiline text, whether outside or inside blocks, is not changing at all. They all remain as they were before I ran the routine.

[Anonymous]

jdiala,

Thank you for your response.

Upon loading, your routine returns the error: error: bad argument type: consp "<OR".

Then when I try to initiate I get "unknown command"

[Anonymous]

Ranjit,

Thank you for your response. I have tried your routine with a varying degree of success.

When I run it "as-is" it changes most of what I need including most blocks; however, I have one block in my drawings where neither the single line nor the multiline strings of text it includes will change.

Please see the attached test drawing which has numerous instances of example text I need to change.

This test includes instances (in magenta color) of single and multi line text; inside and outside blocks; and in the model, and in the layout.

For simplicity, I have made all my test text in this drawing to read "Old String" so that your routine may be run exactly as you have given it to me.

If you run this test with your routine you will notice that everything changes except for the text in the "Notes" block on the layout.

In this block there will still be an instance of single line text and an instance of multiline text that refuses to change.

Yet in the "Logo" block they both change.

Any thoughts on why the text in the Notes block will not change, or what can be added to the routine to make it work with these blocks?

You help is appreciated.

[john.uhden]

Mtext creates an additional challenge... it can be lacerated with various formatting codes for width, color, line return, and a number of other codes that when read literally might not equal the search string.  I wrote an UNFORMAT function (see below) years ago that was used in STRIPMTEXT by Steve Doman and Joe Burke.  That's the easy part.  Putting the formatting back in where it belonged would be a real challenge, unless you can do without the formatting.

  (defun @UnFormat (Mtext Formats / All Format1 Format2 Text Str)
    ;;--------------------------------------------------
    ;; Primary function to perform the format stripping:
    ;; (04-20-03) John F. Uhden, Cadlantic
    ;; Arguments:
    ;;   Mtext   - the Mtext VLA-Object or Ename
    ;;   Formats - a string containing some or all of the following characters:
    ;;     A - Alignment
    ;;     C - Color
    ;;     F - Font
    ;;     H - Height
    ;;     L - Underscore
    ;;     O - Overscore
    ;;     P - Linefeed (Paragraph)
    ;;     Q - Obliquing
    ;;     S - Spacing (Stacking)
    ;;     T - Tracking
    ;;     W - Width
    ;;     ~ - Non-breaking Space
    ;;   Optional Formats -
    ;;     * - All formats
    ;; Returns:
    ;;   nil  - if not a valid Mtext object
    ;;   Text - the Mtext textstring with none, some, or all
    ;;          of the formatting removed, depending on what
    ;;          formats were present and what formats were
    ;;          specified for removal.
    ;;
    (cond
      ((= (type Mtext) 'VLA-Object))
      ((= (type Mtext) 'ENAME)
        (setq Mtext (vlax-ename->vla-object Mtext))
      )
      (1 (setq Mtext nil))
    )
    (and
      Mtext
      (= (vlax-get Mtext 'ObjectName) "AcDbMText")
      (= (type Formats) 'STR)
      (setq Formats (strcase Formats))
      (setq Mtext (vlax-get Mtext 'TextString))
      (setq Text "")
      (setq All T)
      (if (= Formats "*")
        (setq Formats "S"
              Format1 "\\[LOP`~]"
              Format2 "\\[ACFHQTW]"
        )
        (progn
          (setq Format1 "" Format2 "")
          (foreach item '("L" "O" "P" "~")
            (if (vl-string-search item Formats)
              (setq Format1 (strcat Format1 "`" item))
              (setq All nil)
            )
          )
          (if (= Format1 "")
            (setq Format1 nil)
            (setq Format1 (strcat "\\[" Format1 "]"))
          )
          (foreach item '("A" "C" "F" "H" "Q" "T" "W")
            (if (vl-string-search item Formats)
              (setq Format2 (strcat Format2 item))
              (setq All nil)
            )
          )
          (if (= Format2 "")
            (setq Format2 nil)
            (setq Format2 (strcat "\\[" Format2 "]"))
          )
          T
        )
      )
      (while (/= Mtext "")
        (cond
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
            (setq Mtext (substr Mtext 3)
                  Text   (strcat Text Str)
            )
          )
          ((and All (wcmatch (substr Mtext 1 1) "[{}]"))
            (setq Mtext (substr Mtext 2))
          )
          ((and Format1 (wcmatch (strcase (substr Mtext 1 2)) Format1))
            (setq Mtext (substr Mtext 3))
          )
          ((and Format2 (wcmatch (strcase (substr Mtext 1 2)) Format2))
            (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext))))
          )
          ((and (vl-string-search "S" Formats)(wcmatch (strcase (substr Mtext 1 2)) "\\S"))
            (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                  Text  (strcat Text (vl-string-translate "#^\\" "   " Str))
                  Mtext (substr Mtext (+ 4 (strlen Str)))
            )
          )
          (1
            (setq Text (strcat Text (substr Mtext 1 1))
                  Mtext (substr Mtext 2)
            )
          )
        )
      )
    )
    Text
  )
 

[Ranjit_Singh · Accepted solution]

Try below code

(defun somefunc  (new old / a ent entdata ss1)
  (and (setq ss1 (ssget "_x" (list (cons 0 "MTEXT,TEXT") (cons 1 (strcat "*" old "*")))))
       (mapcar '(lambda (x) (test new old (entget (cadr x)))) (ssnamex ss1)))
  (while (setq a (tblnext "block" (null a)))
    (and (setq ent (tblobjname "block" (cdr (assoc 2 a))))
         (while (setq ent (entnext ent))
           (and (wcmatch (cdr (assoc 0 (setq entdata (entget ent)))) "TEXT,MTEXT")
                (test new old entdata)))))
  (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports)
  (princ))

(defun test (a b c) (entmod (subst (cons 1 (vl-string-subst a b (cdr (assoc 1 c)))) (assoc 1 c) c)))

[dbroad · Accepted solution]

Sorry.  I was off by one character.  That's what I get for assuming the object name.

;;D. C. Broad, Jr. 1/6/2017
;;call by (replaceall "old text" "new text")
(defun replaceall (old new / regex)
  (setq regex (vlax-get-or-create-object "VBScript.RegExp"))
  (vlax-put-property regex 'global actrue)
  (vlax-put-property regex 'ignorecase actrue)
  (vlax-put-property regex 'multiline actrue)
  (vlax-put-property regex 'pattern old)
  ;;process every block
  (vlax-for n  (vla-get-blocks
			    (vla-get-activedocument
			      (vlax-get-acad-object)
			    )
			  )
    (vlax-for m n
    (if	(member (vla-get-objectname m) '("AcDbMText" "AcDbText"))
      (vla-put-textstring
	m
	(vlax-invoke
	  regex
	  'replace
	  (vla-get-textstring m)
	  new
	))))))

[john.uhden]

Does that RegExp thingy work around the embedded mtext formatting?  That would be like magical.

[dbroad]

I don't know but probably.  Why don't you try it out and report back.

[john.uhden]

That's amazing!  It retains the formatting, but it's not perfect.  It seems not to replace sometimes when spaces are part of what's to be replaced.  Also, replacing just one character of a formatted word sometimes eliminates the formatting.  But that's only partial testing.  And it may be due to operator error.

[dbroad]

Thanks for testing.  They can be magical but only if the user understands exactly what the regular expression, at least how to form and test a pattern.  With that in mind and for others who read the thread (OP already knows), this 1999 link might be helpful:

Microsoft Beefs Up VBScript with Regular Expressions

For more complex processing, the documentation also explains the execute method and the match collections returned.

[Anonymous]

Thank you RanjitSingh for thehelp, albeit slightly different, both you and dbroad had excellent solutions to this problem of mine.

Thanks again.

[Anonymous]

Thank you dbroad,both you and RanjitSingh were a great help.

I learn so much every time I post here and dbroad, you always seem to be an integral part of the solutions 🙂

Thanks again.

[Ranjit_Singh]

Glad it worked for you. I learned a good deal about VBScript RegExp from this thread. So thank you and dbroad. Never came across it before. I will certainly be using it in future.