Find and replace text

[zasanil]

I've searched around and found a couple lisps that would find text and replace them (without a dialog). One exmple is from this forum post here: http://forums.augi.com/showthread.php?43053-Take-existing-drawings-and-find-all-quot-quot-and-replac... I have copied the code it below. I wanted to see if anyone could modify it to also find text inside of tables also which it doesn't seem to do.

Thanks!

;-------------------------------------------------------------------------------
; FindReplaceAll - Changes Text, Mtext, Dimensions and Attribute Block entities
; that have a Find$ string with a Replace$ string.
; Arguments: 2
;   Find$ = Phrase string to find
;   Replace$ = Phrase to replace it with
; Syntax: (FindReplaceAll "old string" "new string")
; Returns: Updates Text, Mtext, Dimension and Attribute Block entities
;-------------------------------------------------------------------------------
(defun c:FindReplaceAll (Find$ Replace$ / BlkEntList@ BlkEntName^ BlkEntType$ Cnt#
  DimEntList@ DimEntName^ DimEntType$ EntList@ EntName^ EntType$ FindReplace:
  Mid$ Mid2$ NewText$ Num# Replace$ SS& Text$)
  ;-----------------------------------------------------------------------------
  ; FindReplace: - Returns Str$ with Find$ changed to Replace$
  ; Arguments: 3
  ;   Str$ = Text string
  ;   Find$ = Phrase string to find
  ;   Replace$ = Phrase to replace Find$ with
  ; Returns: Returns Str$ with Find$ changed to Replace$
  ;-----------------------------------------------------------------------------
  (defun FindReplace: (Str$ Find$ Replace$ / Cnt# FindLen# Loop Mid$ NewStr$ ReplaceLen#)
    (setq Loop t Cnt# 1 NewStr$ Str$ FindLen# (strlen Find$) ReplaceLen# (strlen Replace$))
    (while Loop
      (setq Mid$ (substr NewStr$ Cnt# FindLen#))
      (if (= Mid$ Find$)
        (setq NewStr$ (strcat (substr NewStr$ 1 (1- Cnt#)) Replace$ (substr NewStr$ (+ Cnt# FindLen#)))
              Cnt# (+ Cnt# ReplaceLen#)
        );setq
        (setq Cnt# (1+ Cnt#))
      );if
      (if (= Mid$ "") (setq Loop nil))
    );while
    NewStr$
  );defun FindReplace:
  ;-----------------------------------------------------------------------------
  ; Start of Main function
  ;-----------------------------------------------------------------------------
  (if (and (= (type Find$) 'STR)(= (type Replace$) 'STR)(/= Find$ ""))
    (progn
      (if (setq SS& (ssget "x" (list '(-4 . "<AND")'(-4 . "<OR")'(0 . "TEXT")'(0 . "MTEXT")'(0 . "DIMENSION")'(0 . "INSERT")'(-4 . "OR>")(cons 410 (getvar "CTAB"))'(-4 . "AND>"))))
        (progn
          (command "UNDO" "BEGIN")
          (setq Cnt# 0)
          (repeat (sslength SS&)
            (setq EntName^ (ssname SS& Cnt#)
                  EntList@ (entget EntName^)
                  EntType$ (cdr (assoc 0 EntList@))
                  Text$ (cdr (assoc 1 EntList@))
            );setq
            (if (= EntType$ "INSERT")
              (if (assoc 66 EntList@)
                (progn
                  (while (/= (cdr (assoc 0 EntList@)) "SEQEND")
                    (setq EntList@ (entget EntName^))
                    (if (= (cdr (assoc 0 EntList@)) "ATTRIB")
                      (progn
                        (setq Text$ (cdr (assoc 1 EntList@)))
                        (if (wcmatch Text$ (strcat "*" Find$ "*"))
                          (progn
                            (setq ReplaceWith$ (FindReplace: Text$ Find$ Replace$))
                            (entmod (subst (cons 1 ReplaceWith$) (assoc 1 EntList@) EntList@))
                            (entupd EntName^)
                          );progn
                        );if
                      );progn
                    );if
                    (setq EntName^ (entnext EntName^))
                  );while
                );progn
              );if
              (if (wcmatch Text$ (strcat "*" Find$ "*"))
                (progn
                  (setq ReplaceWith$ (FindReplace: Text$ Find$ Replace$))
                  (entmod (subst (cons 1 ReplaceWith$) (assoc 1 EntList@) EntList@))
                  (entupd EntName^)
                );progn
              );if
            );if
            (setq Cnt# (1+ Cnt#))
          );repeat
          (command "UNDO" "END")
        );progn
      );if
    );progn
  );if
  (princ)
);defun FindReplaceAll

[devitg]

Please upload your dwg, where to apply

[zasanil]

Hi there,

Attached is an example drawing. I basicaly want to be able to do what the "FIND" command in autcad does where it will replace a text string with another text string. It would look at every text string in the drawing and replace it. It could be in blocks, nested blocks, tables, text, mtext, attributes, etc. The code I found above works on some items but not all (Not like the "FIND" command).

I'm really after a routine I can incorporate into my lisp program that would act as a function where I could have:

(c:FindReplaceText "old string" "new string")

Thanks!

[devitg]

Please state a true old string newstring at the dwg sample 

[zasanil]

In the example I posted, the oldstring would equal "xxxxxx" and would be replaced by the newstring "900999"

[CADaSchtroumpf · Accepted solution]

Hi,

With this, it seem to do work in object ACAD_TABLE

(defun my_replace_text (new_string old_string / js n ename)
  (vl-load-com)
  (defun string-subst (nam_obj / value_string nbs tmp_nbs)
    (setq value_string (vlax-get nam_obj 'TextString) nbs 0)
    (while nbs
      (if (setq nbs (vl-string-search old_string value_string (setq tmp_nbs nbs)))
        (setq
          value_string (vl-string-subst new_string old_string value_string tmp_nbs)
          nbs (1+ nbs)
        )
      )
    )
    (vlax-put nam_obj 'TextString value_string)
  )
  (defun tabl_subst (obj / eRows eColumns R C val nbs tmp_nbs)
    (setq
      eRows (vla-get-rows obj)
      eColumns (vla-get-columns obj)
      R 0
    )
    (repeat eRows
      (setq C 0)
      (repeat eColumns
        (setq val (vla-GetText obj R C) nbs 0 tmp_nbs nil)
        (while nbs
          (if (setq nbs (vl-string-search old_string val (setq tmp_nbs nbs)))
            (setq
              val (vl-string-subst new_string old_string val tmp_nbs)
              nbs (1+ nbs)
            )
          )
        )
        (vla-SetText obj R C val)
        (setq C (+ C 1))
      )
      (setq R (+ R 1))
    )
  )
  (setq js
    (ssget "_X"
      '(
        (-4 . "<OR")
          (0 . "*TEXT,MULTILEADER,ATTDEF,ACAD_TABLE")
          (-4 . "<AND")
            (0 . "INSERT") (66 . 1)
          (-4 . "AND>")
        (-4 . "OR>")
      )
    )
  )
  (cond
    (js
      (repeat (setq n (sslength js))
        (setq ename (vlax-ename->vla-object (ssname js (setq n (1- n)))))
        (cond
          ((vlax-property-available-p ename 'TextString)
            (string-subst ename)
          )
          ((vlax-property-available-p ename 'Rows)
            (tabl_subst ename)
          )
          (T
            (mapcar 
              '(lambda (att)
                (string-subst att)
              )
              (vlax-invoke ename 'GetAttributes)
            )
          )
        )
      )
    )
  )
  (prin1)
)

Use (my_replace_text "900999" "xxxxxx")

This syntax can be used in a script for multiples drawings...

[zasanil]

Hi CADAStroumph,

That does work great for tables and attributes. Would it be easy to adjust it so it will search and replace in blocks / nested blockes also? I think thats one of the only peices I'm missing.

Thanks!

[CADaSchtroumpf · Accepted solution]

so it will search and replace in blocks / nested blockes also?

You can try, just work's with attribut in nested blocks, after is hard to me to continue in nested block for table or other.

(defun my_replace_text (new_string old_string / js n ename first_blk l_blk n_blk)
  (vl-load-com)
  (defun xplore (l / ent cnt msg)
    (setq ent (entget (cdr (assoc -2 l))) cnt 0)
    (cond
      ((eq (cdr (assoc 0 ent)) "INSERT")
        (mapcar 
          '(lambda (att)
            (string-subst att)
          )
          (vlax-invoke (vlax-ename->vla-object (cdar ent)) 'GetAttributes)
        )
        (while (setq ent (entnext (cdar ent)))
          (setq ent (entget ent))
          (if (eq (cdr (assoc 0 ent)) "INSERT")
            (progn
              (setq cnt (1+ cnt))
              (repeat cnt
                (mapcar 
                  '(lambda (att)
                    (string-subst att)
                  )
                  (vlax-invoke (vlax-ename->vla-object (cdar ent)) 'GetAttributes)
                )
              )
            )
          )
        )
      )
    )
  )
  (defun string-subst (nam_obj / value_string nbs tmp_nbs)
    (setq value_string (vlax-get nam_obj 'TextString) nbs 0)
    (while nbs
      (if (setq nbs (vl-string-search old_string value_string (setq tmp_nbs nbs)))
        (setq
          value_string (vl-string-subst new_string old_string value_string tmp_nbs)
          nbs (1+ nbs)
        )
      )
    )
    (vlax-put nam_obj 'TextString value_string)
  )
  (defun tabl_subst (obj / eRows eColumns R C val nbs tmp_nbs)
    (setq
      eRows (vla-get-rows obj)
      eColumns (vla-get-columns obj)
      R 0
    )
    (repeat eRows
      (setq C 0)
      (repeat eColumns
        (setq val (vla-GetText obj R C) nbs 0 tmp_nbs nil)
        (while nbs
          (if (setq nbs (vl-string-search old_string val (setq tmp_nbs nbs)))
            (setq
              val (vl-string-subst new_string old_string val tmp_nbs)
              nbs (1+ nbs)
            )
          )
        )
        (vla-SetText obj R C val)
        (setq C (+ C 1))
      )
      (setq R (+ R 1))
    )
  )
  (setq first_blk (tblnext "BLOCK" T))
  (cond
    (first_blk
      (setq l_blk (list first_blk))
      (while (setq n_blk (tblnext "BLOCK"))
        (setq l_blk (cons n_blk l_blk))
      )
      (foreach n l_blk
        (if (/= (logand (cdr (assoc 70 n)) 4) 4)
          (if (/= (logand (cdr (assoc 70 n)) 16) 16)
            (xplore n)
          )
        )
      )
    )
  )
  (setq js
    (ssget "_X"
      '(
        (-4 . "<OR")
          (0 . "*TEXT,MULTILEADER,ATTDEF,ACAD_TABLE")
          (-4 . "<AND")
            (0 . "INSERT") (66 . 1)
          (-4 . "AND>")
        (-4 . "OR>")
      )
    )
  )
  (cond
    (js
      (repeat (setq n (sslength js))
        (setq ename (vlax-ename->vla-object (ssname js (setq n (1- n)))))
        (cond
          ((vlax-property-available-p ename 'TextString)
            (string-subst ename)
          )
          ((vlax-property-available-p ename 'Rows)
            (tabl_subst ename)
          )
          (T
            (mapcar 
              '(lambda (att)
                (string-subst att)
              )
              (vlax-invoke ename 'GetAttributes)
            )
          )
        )
      )
    )
  )
  (prin1)
)

[CADaSchtroumpf]

Don't forget to execute REGENALL at the end of the procedure to see the changes...

[zasanil]

Thank you for your help CADStroumph! I appriciate it.

[David125]

For people who have not done coding in a long long time, where do I incorporate my input for the text I want to replace?

[Kent1Cooper]

The word after (defun at the top is the function name.  The things after the left parenthesis following that and before the slash are the arguments that need to be supplied.  So to use it, type in a left parenthesis followed by the function name followed by values for the arguments [which in this case must be text strings] followed by a right parenthesis.  Note the order of the arguments.  To replace "that" [the old string] with "this" [the new string]:

(my_replace_text "this" "that")

[Designer-Drafter_Joe]

Hello!  I have tried this code and I get an error before it does anything, which is "; error: Automation Error. Currently write protected".  Does anyone know what this means?  I've used other code to do the same thing but the result is the same as this.

Thank you for your time!

Drafter_Joe  

[ec-cad]

The error is due to 'something' in the vl portion of the code. You don't say 'which' Code you are using,

so it's hard to determine. Perhaps it is finding the target text is within a Dynamic block or a Dim that

is not 'changeable' .. or is write-protected.

ECCAD

[Designer-Drafter_Joe]

Hello ec-cad,

You are correct, I did not identify which of the 3 codes I was referring to.  I tried all three of them and got the same response.  I suppose I need code that disregards whatever text is found that is write-protected.  Unfortunately, I don't know Visual LISP, and I don't have any reference materials to help.  Might you, or someone else, have some example code that I can learn from?

Thank you!!

Drafter_Joe

[ec-cad]

Drafter_Joe. What I do with the 'tough' ones, is set a variable to 0 atop the lisp file,

then down the program, insert (setq variable 1) or 2, 3. etc. to get an idea of the 'area' in code

that is failing. Error trapping can also be used, or vl-catch-all-apply (search for that here) , or use VLIDE and step through

the code. Try the first approach using the Test.lsp attached. At Command Prompt, type !FLAG to find

the next #, that should be the area of concern.

I don't know of a way to capture that 'write-protect' error and have it recover.

ECCAD

[Designer-Drafter_Joe]

ECCAD, That makes very good sense, great tip! Thank you! I will give your suggestion a try very soon and let you know the results. Incidentally, I found another LISP routine that did work, called "srxText" from CAD Studio, it's mentioned above in this post. Thank you again!

[ec-cad]

Good Luck.

Glad you found a solution.

Cheers.!

ECCAD

[Designer-Drafter_Joe]

Well, I didn't finish that like I thought I did, started to mention a "But," deleted it and sent my reply without noticing.  Anyway, it works well, but it's an executable, .vlx program, can't use as a subroutine to have it run multiple times in a row like with the other ones in this thread.  Again, I'll report back on any progress.

Thank you!

Drafter_Joe 

[ec-cad]

Sure, you (can) run it multiple times. You load it, run it. That yields a 'last' command.

You just hit the Enter key after making the first run, then hit the Enter key to repeat

that last command.

ECCAD