Guest Posted July 18, 2019 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
Steven P Posted July 18, 2019 Share Posted 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Quote Link to comment Share on other sites More sharing options...
ronjonp Posted July 18, 2019 Share Posted July 18, 2019 You could use vl-string-translate: (vl-string-translate "ABCD" "1234" "ABCD_ABCDDDDABCD_ABCDCCC") ;; Returns "1234_12344441234_1234333" Quote Link to comment Share on other sites More sharing options...
Guest Posted July 18, 2019 Share Posted July 18, 2019 (edited) i want to translate this leters from any text or mtext in the drawing characters.txt Edited July 18, 2019 by prodromosm Quote Link to comment Share on other sites More sharing options...
ronjonp Posted July 18, 2019 Share Posted 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 "ÔÇÉÓ ÉÓ ÌØ ÇÁÐÐØ ËÉÔÔËÅ ÓÔÑÉÍà ÔÏ ÑÅÐËÁ×Å ÙÉÔÇ ÏÄÄ ×ÇÁÑÁ×ÔÅÑÓ" Quote Link to comment Share on other sites More sharing options...
Guest Posted July 18, 2019 Share Posted July 18, 2019 (defun f00 (string)(vl-string-translate "ABCDEFGHIKLMNOPQRSTUWXYZ" "ΑΒΧΔΕΦΓΗΙΚΛΜΝΟΠΘΡΣΤΥΩΞΨΖ" string)) is not working Quote Link to comment Share on other sites More sharing options...
ronjonp Posted July 18, 2019 Share Posted July 18, 2019 (edited) 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 Quote Link to comment Share on other sites More sharing options...
Guest Posted July 18, 2019 Share Posted July 18, 2019 IS GREEK Quote Link to comment Share on other sites More sharing options...
Guest Posted July 18, 2019 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
Guest Posted July 18, 2019 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
ronjonp Posted July 18, 2019 Share Posted 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) ) Quote Link to comment Share on other sites More sharing options...
Guest Posted July 18, 2019 Share Posted July 18, 2019 (LOAD "C:/Users/Prodromos/Desktop/foo.lsp") nil Command: FOO ; error: no function definition: STRING is not working Quote Link to comment Share on other sites More sharing options...
Guest Posted July 18, 2019 Share Posted July 18, 2019 now works but i have problem with the characters !! Quote Link to comment Share on other sites More sharing options...
Guest Posted July 18, 2019 Share Posted 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 ? Quote Link to comment Share on other sites More sharing options...
Steven P Posted July 19, 2019 Share Posted July 19, 2019 (edited) 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 Quote Link to comment Share on other sites More sharing options...
Guest Posted July 19, 2019 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
Steven P Posted July 19, 2019 Share Posted 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Quote Link to comment Share on other sites More sharing options...
Guest Posted July 19, 2019 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
Guest Posted July 19, 2019 Share Posted July 19, 2019 working only for text not for mtext but i have problem with the characters !! I can not read them Quote Link to comment Share on other sites More sharing options...
Guest Posted July 19, 2019 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.