Find and Replace without Dialogue Box

[bustr]

Is there a way to replace text and attribute values without this dialogue box? I have several values that need to be replaced and the lisp routine that I ordinarily use is not working. The text of the lisp is below the picture.

 

 

 

(defun c:REPLACER ()

  (setq ss_blk (ssget "x" '((0 . "INSERT") (66 . 1))))

  (if ss_blk
    (progn

      (setq lst_blk (sel2lst ss_blk))

      (foreach en_blk lst_blk

    (setq lst_atts (att2lst en_blk))
    (setq str_line "")
    (foreach en_atts lst_atts
      (setq str_line (getval 1 en_atts))
      (if (not (wcmatch str_line "*/*/*"))
        (progn

        (setq str_line (strchg str_line "06/13/19" "07/26/19"))
        (setq str_line (strchg str_line "06/14/19" "07/26/19"))
        (setq str_line (strchg str_line "07/22/19" "07/26/19"))

          (setval 1 str_line en_atts)
        )
      )
    )
      )
    )
  )


  (setq ss_txtlines (ssget "x" '((0 . "TEXT"))))

  (if ss_txtlines
    (progn

      (setq lst_txtlines (sel2lst ss_txtlines))
      (setq str_line "")

      (foreach en_txtlines lst_txtlines

    (setq str_line (getval 1 en_txtlines))
    (if (not (wcmatch str_line "*/*/*"))
      (progn

        (setq str_line (strchg str_line "06/13/19" "07/26/19"))
        (setq str_line (strchg str_line "06/14/19" "07/26/19"))
        (setq str_line (strchg str_line "07/22/19" "07/26/19"))

        (setval 1 str_line en_txtlines)
      )
    )
      )
    )
  )
)

 

[Steven P]

Try this, use the command txtreplace:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:txtreplace( / old_text new_text)
  (setq old_text (getstring T "OLD Text to replace (replace in this model/paper space and text case as entered): "))
  (setq new_text (getstring T "NEW text to use: "))
  (FindReplaceAll old_text new_text)
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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
; It is Case sensitive
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-and-replace-text/td-p/5649883
;-------------------------------------------------------------------------------
(defun 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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

[bustr]

Thanks. Where in the code do I place the old and new values?

[BIGAL]

a hint   Syntax: (FindReplaceAll "old string" "new string")

[SLW210]

I have moved your thread to the AutoLISP, Visual LISP & DCL Forum. Please post in the most appropriate forum.

[dlanorh]

Or try this

 

(defun c:REPLACER ( / o_lst n_lst ss_blk cnt blk atts n ss_txt obj)

  (setq o_lst (list "06/13/19" "06/14/19" "07/22/19")
        n_lst (list "07/26/19" "07/26/19" "07/26/19")
        ss_blk (ssget "x" '((0 . "INSERT") (66 . 1)))
  );end_setq

  (cond (ss_blk
          (repeat (setq cnt (sslength ss_blk))
            (setq blk (vlax-ename->vla-object (ssname ss_blk (setq cnt (1- cnt))))
                  atts (vlax-invoke blk 'getattributes)
            );end_setq
            (foreach att atts
              (if (setq n (vl-position (vlax-get-property att 'textstring) o_lst)) (vlax-put-property att 'textstring (nth n n_lst)))
            );end_foreach
          );end_repeat
        )
  );end_cond

  (setq ss_txt (ssget "x" '((0 . "TEXT"))))

  (cond (ss_txt
          (repeat (setq cnt (sslength ss_txt))
            (setq obj (vlax-ename->vla-object (ssname ss_txt (setq cnt (1- cnt)))))
            (if (setq n (vl-position (vlax-get-property obj 'textstring) o_lst)) (vlax-put-property obj 'textstring (nth n n_lst)))
          );end_repeat
        )
  );end_cond
  (princ)
);end_defun
(vl-load-com)
(princ)

 

[bustr]

Thanks dlanorh. That worked.

[dlanorh]

13 minutes ago, bustr said:

Thanks dlanorh. That worked.

 

No problems. Do you understand how the two lists (old) o_lst and (new) n_lst work?

 

[bustr]

Yes. Thanks!

[dlanorh]

7 minutes ago, bustr said:

Yes. Thanks!

 

OK. If your want to use this with alphabetical text two lines would require changes

 

The if statement here should be :

            (foreach att atts
              (if (setq n (vl-position (strcase (vlax-get-property att 'textstring)) (mapcar 'strcase o_lst))) (vlax-put-property att 'textstring (nth n n_lst)))
            );end_foreach

 

And likewise here

 

(if (setq n (vl-position (strcase (vlax-get-property obj 'textstring)) (mapcar 'strcase o_lst))) (vlax-put-property obj 'textstring (nth n n_lst)))

 

[bustr]

That works. Thanks again!