TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Shade on October 24, 2007, 02:08:07 PM
-
In the following replace text code I am getting the error message ; error: bad DXF group: (1) and I can't seem to figure out why?
(defun C:RTx ()
(setq OLD (getstring "\nReplace text: ")
NEW (getstring "\nNew text: ")
);
(setq SS (ssget "X" (list (cons 0 "INSERT,TEXT,MTEXT,RTEXT,DTEXT,DIMENSION"))))
(if SS
(progn
(repeat (sslength SS)
(setq ENT (ssname SS 0)
EN (entget ENT)
TYP (cdr (assoc 0 EN))
)
(if (= TYP "INSERT")
(PROGN
(IF (assoc 66 EN)
(PROGN
(SETQ SUB1 (ENTNEXT ENT))
(WHILE (= (CDR (assoc 0 (ENTGET SUB1))) "ATTRIB")
(SETQ SUBEN (ENTGET SUB1))
(SETQ STG (CDR (assoc 1 SUBEN)))
(SETQ STG (REPLACE OLD NEW STG))
(entmod (subst (cons 1 STG) (assoc 1 SUBEN) SUBEN))
(SETQ SUB1 (eNTNEXT SUB1))
)
(ENTUPD ENT)
)
)
)
(PROGN
(setq STG (CDR (assoc 1 EN))
STG (REPLACE OLD NEW STG)
)
(entmod (subst (cons 1 STG) (assoc 1 EN) EN))
)
)
(ssdel ENT SS)
)
)
)
);
(defun Replace (OLD NEW STR)
(while (/= (vl-string-search OLD STR) Nil)
(setq TXT (vl-string-subst NEW OLD STR));
);
(setq OLD (strcase OLD))
(while (/= (vl-string-search OLD STR) Nil)
(setq TXT (vl-string-subst NEW OLD STR));
);
);
Any help would be appreciated.
-
Fixed a few problems, did not test attributes. Give it a go.
(defun C:RTx (/ EN ENT NEW OLD SS STG SUB1 SUBEN TYP)
(setq OLD (getstring "\nReplace text: ")
NEW (getstring "\nNew text: ")
) ;
(setq
SS (ssget "X" (list (cons 0 "INSERT,TEXT,MTEXT,RTEXT,DTEXT,DIMENSION")))
)
(if SS
(progn
(repeat (sslength SS)
(setq ENT (ssname SS 0)
EN (entget ENT)
TYP (cdr (assoc 0 EN))
)
(if (= TYP "INSERT")
(progn
(if (assoc 66 EN)
(progn
(setq SUB1 (entnext ENT))
(while (= (cdr (assoc 0 (entget SUB1))) "ATTRIB")
(setq SUBEN (entget SUB1))
(setq STG (cdr (assoc 1 SUBEN)))
(setq STG (REPLACE OLD NEW STG))
(entmod (subst (cons 1 STG) (assoc 1 SUBEN) SUBEN))
(setq SUB1 (entnext SUB1))
)
(entupd ENT)
)
)
)
(progn
(setq STG (cdr (assoc 1 EN))
STG (REPLACE OLD NEW STG)
)
(if STG
(entmod (subst (cons 1 STG) (assoc 1 EN) EN))
)
)
)
(ssdel ENT SS)
)
)
)
) ;
(defun Replace (OLD NEW STR)
(if (and old new str)
(progn
(setq OLD (strcase OLD t))
(while (vl-string-search OLD STR)
(setq STR (vl-string-subst NEW OLD STR)) ;
) ;
(setq OLD (strcase OLD))
(while (vl-string-search OLD STR)
(setq STR (vl-string-subst NEW OLD STR)) ;
)
)
)
STR
)
-
I have discovered the error occurs in this sub program, but I am still unable to solve the error.
What I wish to do is replace all cases of the existing text and every occurrence of the existing text in the string.
(Defun Replace (OLD NEW STR)
(if (and old new str)
(progn
(setq OLD (strcase OLD t))
(while (vl-string-search OLD STR)
(setq STR (vl-string-subst NEW OLD STR)) ;
) ;
(setq OLD (strcase OLD))
(while (vl-string-search OLD STR)
(setq STR (vl-string-subst NEW OLD STR)) ;
)
)
)
STR
);
Thanks for the help CAB but the the lisp only replaced the first exact match of the text and I need it to replace all occurrences in both upper and lower case.
-
Not sure what the error you are encountering, but if the original text has mixed case this subroutine will not get those.
What is the nature of the failure?
-
(defun test
(NewPattern
Pattern
String
/
Pos
PatternLen
CasePattern
CaseString
LenDiff
Counter
)
(setq Counter 0
PatternLen (strlen Pattern)
LenDiff (- (strlen NewPattern) PatternLen)
CasePattern (strcase Pattern)
CaseString (strcase String)
)
(while (setq Pos (vl-string-search CasePattern CaseString Pos))
(setq String (strcat (substr String 1 (+ Pos (* LenDiff Counter)))
NewPattern
(substr String
(+ 1 (* LenDiff Counter) (setq Pos (+ Pos PatternLen)))
)
)
)
(setq Counter (1+ Counter))
)
String
)
-
(defun test
(NewPattern
Pattern
String
/
Pos
PatternLen
CasePattern
CaseString
LenDiff
Counter
)
(setq Counter 0
PatternLen (strlen Pattern)
LenDiff (- (strlen NewPattern) PatternLen)
CasePattern (strcase Pattern)
CaseString (strcase String)
)
(while (setq Pos (vl-string-search CasePattern CaseString Pos))
(setq String (strcat (substr String 1 (+ Pos (* LenDiff Counter)))
NewPattern
(substr String
(+ 1 (* LenDiff Counter) (setq Pos (+ Pos PatternLen)))
)
)
)
(setq Counter (1+ Counter))
)
String
)
Hi VovKa, welcome on board
Your routine worked nice for me
Tested on A2007-8
Cheers :)
~'J'~
-
VovKa welcome to TheSwamp, that function worked well. :-)
-
Here is a modified version. Building an index & then doing the replacements.
;; CAB 10.25.2007
(defun strReplace (new old str / target len TestStr Pos index)
(setq target (strcase old)
len (strlen old)
TestStr (strcase str)
Pos 0
)
(while (setq Pos (vl-string-search target TestStr Pos))
(setq index (cons pos index)
Pos (+ Pos len))
)
(mapcar
'(lambda (x)
(setq str (vl-string-subst new (substr str (1+ x) len) Str x)))
index
)
str
)