Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Find and replace text

11 REPLIES 11
SOLVED
Reply
Message 1 of 12
zasanil
8344 Views, 11 Replies

Find and replace text

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
Dan Nicholson C.I.D.
PCB Design Engineer
Tags (4)
11 REPLIES 11
Message 2 of 12
devitg
in reply to: zasanil

Please upload your dwg, where to apply

Message 3 of 12
zasanil
in reply to: devitg

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!

Dan Nicholson C.I.D.
PCB Design Engineer
Message 4 of 12
devitg
in reply to: zasanil

Please state a true old string newstring at the dwg sample 

Message 5 of 12
zasanil
in reply to: devitg

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

Dan Nicholson C.I.D.
PCB Design Engineer
Message 6 of 12
CADaSchtroumpf
in reply to: zasanil

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...

Message 7 of 12
zasanil
in reply to: CADaSchtroumpf

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!

Dan Nicholson C.I.D.
PCB Design Engineer
Message 8 of 12
CADaSchtroumpf
in reply to: zasanil

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)
)

 

Message 9 of 12

Don't forget to execute REGENALL at the end of the procedure to see the changes...
Message 10 of 12
zasanil
in reply to: CADaSchtroumpf

Thank you for your help CADStroumph! I appriciate it.

Dan Nicholson C.I.D.
PCB Design Engineer
Message 11 of 12
David125
in reply to: CADaSchtroumpf

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?

Message 12 of 12
Kent1Cooper
in reply to: David125

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")

Kent Cooper, AIA

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost