FIND AND REPLACE MULTYPLE LETTERS

July 18, 2019

HI i am searching for a lisp to replace multyple letters from mtext

for exaple to replaxe A,B,C,D,E,F,G,K,L,,M,N WITH Α,Β,Γ,Δ,Ε,Ζ,Η,Θ,Ι,Κ ......

THANKS

July 18, 2019

This might give you a start, command txtreplace which you could modify to accept multiple inputs and then run the FindReplaceAll function for each letter. Note this is case sensitive.

;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-and-replace-text/td-p/5649883
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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
;-------------------------------------------------------------------------------
(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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

July 18, 2019

You could use vl-string-translate:

(vl-string-translate "ABCD" "1234" "ABCD_ABCDDDDABCD_ABCDCCC")
;; Returns "1234_12344441234_1234333"

July 18, 2019

i want to translate this leters from any text or mtext in the drawing

characters.txt

Edited July 18, 2019 by prodromosm

July 18, 2019

30 minutes ago, prodromosm said:

i want to translate this leters

characters.txt 216 B · 0 downloads

Try this:


(defun f00 (string)(vl-string-translate "ABCDEFGHIKLMNOPQRSTUWXYZ" "ÁÂ×ÄÅÖÃÇÉÊËÌÍÏÐÈÑÓÔÕÙÎØÆ" string))
(F00 "THIS IS MY HAPPY LITTLE STRING TO REPLACE WITH ODD CHARACTERS")
;; RESULT "ÔÇÉÓ ÉÓ ÌØ ÇÁÐÐØ ËÉÔÔËÅ ÓÔÑÉÍÃ ÔÏ ÑÅÐËÁ×Å ÙÉÔÇ ÏÄÄ ×ÇÁÑÁ×ÔÅÑÓ"

July 18, 2019

(defun f00 (string)(vl-string-translate "ABCDEFGHIKLMNOPQRSTUWXYZ" "ΑΒΧΔΕΦΓΗΙΚΛΜΝΟΠΘΡΣΤΥΩΞΨΖ" string))

is not working

July 18, 2019

39 minutes ago, prodromosm said:


(defun f00 (string)(vl-string-translate "ABCDEFGHIKLMNOPQRSTUWXYZ" "ΑΒΧΔΕΦΓΗΙΚΛΜΝΟΠΘΡΣΤΥΩΞΨΖ" string))

is not working

I cannot read those symbols in your last example: "?????FG????????T?S??O???"

Edited July 18, 2019 by ronjonp

July 18, 2019

IS GREEK

July 18, 2019

The problem is not the symbols i will change them .I sent a sample to understand how the text is

test.dwg

July 18, 2019

The idea is to replace each character with spesyfic other character.

for examle replace B with G , F with D ,H with S .................. then i relace this letters with the correct

July 18, 2019

59 minutes ago, prodromosm said:

The problem is not the symbols i will change them .I sent a sample to understand how the text is

test.dwg 118.84 kB · 0 downloads

Works here although your formatting gets jacked:

(defun c:foo (/ f00 e)
  (defun f00 (string)
    (vl-string-translate "ABCDEFGHIKLMNOPQRSTUWXYZ" "ÁÂ×ÄÅÖÃÇÉÊËÌÍÏÐÈÑÓÔÕÙÎØÆ" string)
  )
  (if (and (setq e (car (entsel "\Pick text: ")))
	   (setq e (vlax-ename->vla-object e))
	   (vlax-property-available-p e 'textstring)
      )
    (vla-put-textstring e (f00 (vla-get-textstring e)))
  )
  (princ)
)

July 18, 2019

(LOAD "C:/Users/Prodromos/Desktop/foo.lsp") nil

Command: FOO
; error: no function definition: STRING

is not working

July 18, 2019

now works but i have problem with the characters !!

July 18, 2019

I can not understand .Whrn i use Edit -> find and replace the character is ok. When i use

vl-string-translate

i can not red the text? is any other way to replace the text ?

July 19, 2019

This is a bit more long winded than ronjonp, not so nice to look at, use the FindReplaceAll that I posted above add this:

(defun c:multipletxtreplace( / cmdecho_old replaceletters acount)
  (setq cmdecho_old (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq replaceletters (list '("a" "A") '("b" "B") '("c" "C") '("d" "D") '("e" "E") '("f" "F")) ) ;;complete list as required.
  (setq account 0)
  (repeat (length replaceletters)
    (FindReplaceAll (nth 0 (nth account replaceletters)) (nth 1 (nth account replaceletters)) )
    (setq account (+ 1 account))
  )
  (setvar "cmdecho" cmdecho_old)
  (princ)
)

Replace pairs of text in the replaceletters list in the form (list '( "old text" "new text" ) .... ).

Oh, 'FindReplaceAll' as it is will replace text in the whole model / paper space you are in at the time - not just selected text

Edited July 19, 2019 by Steven P

July 19, 2019

Hi Steven P. I update the code but give me an error

(defun c:multipletxtreplace( / cmdecho_old replaceletters acount)
  (setq cmdecho_old (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq replaceletters (list '("A" "Α") '("B" "Β") '("C" "Χ") '("D" "Δ") '("E" "Ε") '("F" "Φ") '("G" "Γ") '("H" "Η") '("I" "Ι") '("K" "Κ") '("L" "Λ") '("M" "Μ") '("N" "Ν") '("O" "Ο") '("P" "Π") '("Q" "Θ") '("R" "Ρ") '("S" "Σ") '("T" "Τ") '("U" "Υ") '("W" "Ω") '("X" "Ξ") '("Y" "Ψ") '("Z" "Ζ")) ) ;;complete list as required.
  (setq account 0)
  (repeat (length replaceletters)
    (FindReplaceAll (nth 0 (nth account replaceletters)) (nth 1 (nth account replaceletters)) )
    (setq account (+ 1 account))
  )
  (setvar "cmdecho" cmdecho_old)
  (princ)
)

Quote

Command: MULTIPLETXTREPLACE
; error: no function definition: FINDREPLACEALL

July 19, 2019

3 hours ago, prodromosm said:

Hi Steven P. I update the code but give me an error

That's strange, it should work OK. Just to check that you have both parts:

(defun c:multipletxtreplace( / cmdecho_old replaceletters acount)
  (setq cmdecho_old (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq replaceletters (list '("A" "Α") '("B" "Β") '("C" "Χ") '("D" "Δ") '("E" "Ε") '("F" "Φ") '("G" "Γ") '("H" "Η") '("I" "Ι") '("K" "Κ") '("L" "Λ") '("M" "Μ") '("N" "Ν") '("O" "Ο") '("P" "Π") '("Q" "Θ") '("R" "Ρ") '("S" "Σ") '("T" "Τ") '("U" "Υ") '("W" "Ω") '("X" "Ξ") '("Y" "Ψ") '("Z" "Ζ")) ) ;;complete list as required.
  (setq account 0)
  (repeat (length replaceletters)
    (FindReplaceAll (nth 0 (nth account replaceletters)) (nth 1 (nth account replaceletters)) )
    (setq account (+ 1 account))
  )
  (setvar "cmdecho" cmdecho_old)
  (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
;-------------------------------------------------------------------------------
(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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

July 19, 2019

I load the lisp with the command

multipletxtreplace

and is not working . Attach a lisp file because i dont know why it is not working

July 19, 2019

working only for text not for mtext but i have problem with the characters !! I can not read them

July 19, 2019

I can not understan why. Wheni i use Edit -> find and replace the character is ok. When i use a lisp to translate the letters the text is not readable

Sign In

FIND AND REPLACE MULTYPLE LETTERS

Recommended Posts

Guest

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Steven P

ronjonp

Guest

ronjonp

Guest

ronjonp

Guest

Guest

Guest

ronjonp

Guest

Guest

Guest

Steven P

Guest

Steven P

Guest

Guest

Guest

Join the conversation

Tutorials

Forums

Activity