FIND AND REPLACE MULTYPLE LETTERS

[Guest]

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

[Steven P]

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

 

[ronjonp]

You could use vl-string-translate:

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

 

[Guest]

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

 

characters.txt

Edited July 18, 2019 by prodromosm

[ronjonp]

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 "ÔÇÉÓ ÉÓ ÌØ ÇÁÐÐØ ËÉÔÔËÅ ÓÔÑÉÍà ÔÏ ÑÅÐËÁ×Å ÙÉÔÇ ÏÄÄ ×ÇÁÑÁ×ÔÅÑÓ" 

 

[Guest]

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

is not working

[ronjonp]

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

[Guest]

IS GREEK

[Guest]

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

test.dwg

[Guest]

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

[ronjonp]

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

 

[Guest]

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

Command: FOO
; error: no function definition: STRING

is not working

[Guest]

now works but i have problem with the characters !!

 

[Guest]

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 ?

[Steven P]

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

[Guest]

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

 

[Steven P]

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

 

[Guest]

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

 

[Guest]

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

[Guest]

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