;;; a rudimentary text editor Frank Emerick, RBCulp
(defun c:cx () (c:chgtext))
(defun C:CHGTEXT () (cht_Edit nil))
(defun cht_Edit (objs / last_o tot_o ent o_str n_str st s_temp
n_slen o_slen si chf chm cont ans class)
(command "undo" "BEGIN")
(if (null objs)
(setq objs (ssget))
)
(setq chm 0)
(if objs
(progn ;; If any objects selected
(if (= (type objs) 'ENAME)
(progn
(setq ent (entget objs))
(princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
)
(if (= (sslength objs) 1)
(progn
(setq ent (entget (ssname objs 0)))
(princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
)
)
)
(setq o_str (getstring "\nMatch string : " t))
(setq o_slen (strlen o_str))
(if (/= o_slen 0)
(progn
(setq n_str (getstring "\nNew string : " t))
(setq n_slen (strlen n_str))
(setq last_o 0
tot_o (if (= (type objs) 'ENAME)
1
(sslength objs)
)
)
;; For each selected object...
(while (< last_o tot_o)
(setq class (cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
(if (cond (= "TEXT" class)
(= "mtext" class)
(= "DIMENSION" class) )
(progn
(setq chf nil si 1)
(setq s_temp (cdr (assoc 1 ent)))
(while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
(if (= st o_str)
(progn
(setq s_temp (strcat
(if (> si 1)
(substr s_temp 1 (1- si))
""
)
n_str
(substr s_temp (+ si o_slen))
)
)
(setq chf t) ;; Found old string
(setq si (+ si n_slen))
)
(setq si (1+ si))
)
)
(if chf
(progn ;; Substitute new string for old
;; Modify the TEXT entity
(entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
(setq chm (1+ chm))
)
)
)
)
(setq last_o (1+ last_o))
)
)
;; else go on to the next line...
)
)
)
(if (/= (type objs) 'ENAME)
;; Print total lines changed
(if (/= (sslength objs) 1)
(princ (strcat (rtos chm 2 0) " text lines changed."))
(terpri)
)
)
(command "undo" "END")
(terpri)
)
Thanks CADaver! :)You're welcome. Bear in mind that it was originally written nearly 18 years ago and has been "tweaked" a bit since. (I think there may be newer/netter versions floating around somewhere.)
You should be about ready to handle that one now, right?
You are in Stig's class aren't you?
;| Routine to find specified text and replace with new text. Works on Text,
Mtext, Attributes and Dimension text overrides.
WARNING: it will change all occurances of a pattern with the new text.
Such as: if "test" "contest" "testing" are all valid text entries in the
drawing, running this: (txtfind "test" "newtest") will change
the original text to "newtest" "connewtest" "newtesting", but for the
original intent of this routine that was not a problem. Modifications
may be made to force matching of whole word only.
by: Jeff Mishler Sept. 2003
|;
(defun txtfind (patt newpatt / count ss ent str txthgt match?)
(vl-load-com)
(vla-startundomark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
(setq ss (ssget "X" '((0 . "TEXT,MTEXT,DIMENSION,INSERT"))))
(if (not ss)
(princ "\nNo Text entities found!")
(progn
(setq count -1)
(while (< (setq count (1+ count))(sslength ss))
(setq ent (entget (ssname ss count))
obj (vlax-ename->vla-object (cdr (car ent))))
(cond
((= (cdr (assoc 0 ent)) "TEXT")
(progn
(setq str (cdr (assoc 1 ent)))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring obj str)
);while
);progn
);first condition
((= (cdr (assoc 0 ent)) "DIMENSION")
(progn
(setq str (cdr (assoc 1 ent)))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textoverride obj str)
);while
);progn
);second condition
((= (cdr (assoc 0 ent)) "MTEXT")
(progn
(setq str (vla-get-textstring obj))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring obj str)
);while
);progn
);third condition
(t
(progn
(if (= (vla-get-hasattributes obj) :vlax-true)
(progn
(setq atts (vla-getattributes obj))
(foreach x (vlax-safearray->list (vlax-variant-value atts))
(setq str (vla-get-textstring x))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring x str)
);while
);for
);progn
);if
);progn
);last condition
);cond
);while
);progn
);if
(vla-endundomark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
(princ)
);defun
(txtfind "badtext" "goodtext")
Here's a function I put together a while back...
8< Snip >8
Command: (txtfind "ABE-4172-AA" "ABE-4172")
; error: ActiveX Server returned an error: Invalid index
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring x str)
);while
);for
Does it happen in the same drawing always? If so maybe you can post a small portion of the drawing. The only reason I can think of (it's early and I'm tried) is that it's trying to replace the items in a spot that is outside the range of letters.8< Snip >8
Any idea as to why I would get this message on some drawings, but not all?QuoteCommand: (txtfind "ABE-4172-AA" "ABE-4172")
; error: ActiveX Server returned an error: Invalid index
Can't really post the drawing, but I could email it to you...Does it happen in the same drawing always? If so maybe you can post a small portion of the drawing. The only reason I can think of (it's early and I'm tried) is that it's trying to replace the items in a spot that is outside the range of letters.8< Snip >8
Any idea as to why I would get this message on some drawings, but not all?QuoteCommand: (txtfind "ABE-4172-AA" "ABE-4172")
; error: ActiveX Server returned an error: Invalid index
Can't really post the drawing, but I could email it to you...Does it happen in the same drawing always? If so maybe you can post a small portion of the drawing. The only reason I can think of (it's early and I'm tried) is that it's trying to replace the items in a spot that is outside the range of letters.8< Snip >8
Any idea as to why I would get this message on some drawings, but not all?QuoteCommand: (txtfind "ABE-4172-AA" "ABE-4172")
; error: ActiveX Server returned an error: Invalid index
I just figured out that even if I get the error message, it will sometimes change the text anyway.
It should also be noted that this text is in an attribute.
(defun txtfind (patt newpatt / count ss ent str txthgt match?)
;| Routine to find specified text and replace with new text. Works on Text,
Mtext, Attributes and Dimension text overrides.
WARNING: it will change all occurances of a pattern with the new text.
Such as: if "test" "contest" "testing" are all valid text entries in the
drawing, running this: (txtfind "test" "newtest") will change
the original text to "newtest" "connewtest" "newtesting", but for the
original intent of this routine that was not a problem. Modifications
may be made to force matching of whole word only.
by: Jeff Mishler Sept. 2003
|;
(vl-load-com)
(vla-startundomark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
(setq ss (ssget "X" '((0 . "TEXT,MTEXT,DIMENSION,INSERT"))))
(if (not ss)
(princ "\nNo Text entities found!")
(progn
(setq count -1)
(while (< (setq count (1+ count))(sslength ss))
(setq ent (entget (ssname ss count))
obj (vlax-ename->vla-object (cdr (car ent))))
(cond
((= (cdr (assoc 0 ent)) "TEXT")
(progn
(setq str (cdr (assoc 1 ent)))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring obj str)
);while
);progn
);first condition
((= (cdr (assoc 0 ent)) "DIMENSION")
(progn
(setq str (cdr (assoc 1 ent)))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textoverride obj str)
);while
);progn
);second condition
((= (cdr (assoc 0 ent)) "MTEXT")
(progn
(setq str (vla-get-textstring obj))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring obj str)
);while
);progn
);third condition
(t
[color=red] (foreach x (vlax-invoke obj 'GetAttributes)
(setq str (vla-get-textstring x))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring x str)
);while
);for[/color]
);last condition
);cond
);while
);progn
);if
(vla-endundomark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
(princ)
);defun
(foreach x (vlax-invoke obj 'GetAttributes)
To(foreach x (append (vlax-invoke obj 'GetAttributes) (vlax-invoke obj 'GetConstantAttributes))
First of all, Thank-you!You're welcome.
Constant? :?I don't use them, but I know they exist. It is a mode that is set like invisible. Here is something from the help, if it helps.
(Checking... )
Mode
Sets options for attribute values associated with a block when you insert the block in a drawing.
The default values are stored in the AFLAGS system variable. Changing the AFLAGS setting affects the default mode for new attribute definitions and does not affect existing attribute definitions.
Invisible
Specifies that attribute values are not displayed or printed when you insert the block. ATTDISP overrides Invisible mode.
Constant
Gives attributes a fixed value for block insertions.
Verify
Prompts you to verify that the attribute value is correct when you insert the block.
Preset
Sets the attribute to its default value when you insert a block containing a preset attribute.
Must have been one of the garbage blocks from the vendor that were on a layer that was turned off... ?
(defun txtfind (patt newpatt / count ss ent str txthgt match?)
;| Routine to find specified text and replace with new text. Works on Text,
Mtext, Attributes and Dimension text overrides.
WARNING: it will change all occurances of a pattern with the new text.
Such as: if "test" "contest" "testing" are all valid text entries in the
drawing, running this: (txtfind "test" "newtest") will change
the original text to "newtest" "connewtest" "newtesting", but for the
original intent of this routine that was not a problem. Modifications
may be made to force matching of whole word only.
by: Jeff Mishler Sept. 2003
|;
(vl-load-com)
(vla-startundomark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
(setq ss (ssget "X" '((0 . "TEXT,MTEXT,DIMENSION,INSERT"))))
(if (not ss)
(princ "\nNo Text entities found!")
(progn
(setq count -1)
(while (< (setq count (1+ count))(sslength ss))
(setq ent (entget (ssname ss count))
obj (vlax-ename->vla-object (cdr (car ent))))
(cond
((= (cdr (assoc 0 ent)) "TEXT")
(progn
(setq str (cdr (assoc 1 ent)))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring obj str)
);while
);progn
);first condition
((= (cdr (assoc 0 ent)) "DIMENSION")
(progn
(setq str (cdr (assoc 1 ent)))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textoverride obj str)
);while
);progn
);second condition
((= (cdr (assoc 0 ent)) "MTEXT")
(progn
(setq str (vla-get-textstring obj))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring obj str)
);while
);progn
);third condition
(t
(foreach x (vlax-invoke obj 'GetAttributes)
(setq str (vla-get-textstring x))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring x str)
);while
);for
);last condition
);cond
);while
);progn
);if
(vla-endundomark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
(princ)
);defun;| Routine to find specified text and replace with new text. Works on Text,
Mtext, Attributes and Dimension text overrides.
WARNING: it will change all occurances of a pattern with the new text.
Such as: if "test" "contest" "testing" are all valid text entries in the
drawing, running this: (txtfind "test" "newtest") will change
the original text to "newtest" "connewtest" "newtesting", but for the
original intent of this routine that was not a problem. Modifications
may be made to force matching of whole word only.
by: Jeff Mishler Sept. 2003
|;
(defun txtfind (patt newpatt / count ss ent str txthgt match?)
(vl-load-com)
(vla-startundomark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
(setq ss (ssget "X" '((0 . "TEXT,MTEXT,DIMENSION,INSERT"))))
(if (not ss)
(princ "\nNo Text entities found!")
(progn
(setq count -1)
(while (< (setq count (1+ count))(sslength ss))
(setq ent (entget (ssname ss count))
obj (vlax-ename->vla-object (cdr (car ent))))
(cond
((= (cdr (assoc 0 ent)) "TEXT")
(progn
(setq str (cdr (assoc 1 ent)))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring obj str)
);while
);progn
);first condition
((= (cdr (assoc 0 ent)) "DIMENSION")
(progn
(setq str (cdr (assoc 1 ent)))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textoverride obj str)
);while
);progn
);second condition
((= (cdr (assoc 0 ent)) "MTEXT")
(progn
(setq str (vla-get-textstring obj))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring obj str)
);while
);progn
);third condition
(t
(progn
(if (= (vla-get-hasattributes obj) :vlax-true)
(progn
(setq atts (vla-getattributes obj))
(foreach x (vlax-safearray->list (vlax-variant-value atts))
(setq str (vla-get-textstring x))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring x str)
);while
);for
);progn
);if
);progn
);last condition
);cond
);while
);progn
);if
(vla-endundomark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
(princ)
);defun
(defun txtfind (patt newpatt / count ss ent str txthgt match? cnt slen)
;| Routine to find specified text and replace with new text. Works on Text,
Mtext, Attributes and Dimension text overrides.
WARNING: it will change all occurances of a pattern with the new text.
Such as: if "test" "contest" "testing" are all valid text entries in the
drawing, running this: (txtfind "test" "newtest") will change
the original text to "newtest" "connewtest" "newtesting", but for the
original intent of this routine that was not a problem. Modifications
may be made to force matching of whole word only.
by: Jeff Mishler Sept. 2003
|;
(vl-load-com)
(vla-startundomark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
(setq slen (strlen newpatt))
(setq ss (ssget "X" '((0 . "TEXT,MTEXT,DIMENSION,INSERT"))))
(if (not ss)
(princ "\nNo Text entities found!")
(progn
(setq count -1)
(while (< (setq count (1+ count))(sslength ss))
(setq ent (entget (ssname ss count))
obj (vlax-ename->vla-object (cdr (car ent))))
(cond
((= (cdr (assoc 0 ent)) "TEXT")
(progn
(setq cnt 0)
(setq str (cdr (assoc 1 ent)))
(while (setq match? (vl-string-search patt str cnt))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring obj str)
(setq cnt (+ slen match?))
);while
);progn
);first condition
((= (cdr (assoc 0 ent)) "DIMENSION")
(progn
(setq cnt 0)
(setq str (cdr (assoc 1 ent)))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textoverride obj str)
(setq cnt (+ slen match?))
);while
);progn
);second condition
((= (cdr (assoc 0 ent)) "MTEXT")
(progn
(setq cnt 0)
(setq str (vla-get-textstring obj))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring obj str)
(setq cnt (+ slen match?))
);while
);progn
);third condition
(t
(foreach x (vlax-invoke obj 'GetAttributes)
(setq cnt 0)
(setq str (vla-get-textstring x))
(while (setq match? (vl-string-search patt str))
(setq str (vl-string-subst newpatt patt str))
(vla-put-textstring x str)
(setq cnt (+ slen match?))
);while
);for
);last condition
);cond
);while
);progn
);if
(vla-endundomark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
(princ)
)
(defun txtfind (patt newpatt / _replacetext e el n obj ss str)
;| Routine to find specified text and replace with new text. Works on Text,
Mtext, Attributes and Dimension text overrides.
WARNING: it will change all occurances of a pattern with the new text.
Such as: if "test" "contest" "testing" are all valid text entries in the
drawing, running this: (txtfind "test" "newtest") will change
the original text to "newtest" "connewtest" "newtesting", but for the
original intent of this routine that was not a problem. Modifications
may be made to force matching of whole word only.
by: Jeff Mishler Sept. 2003
10.16.2012 Modified by RJP to prevent infinite loop when source search includes all or part of replace pattern
Created more refined filter
ie.
(txtfind "AI1" "FAI1")
(txtfind "AI2" "FAI2")
|;
(defun _replacetext (new old textstring / i out tmp)
(cond ((vl-string-search old textstring)
(setq tmp textstring)
(setq out "")
(while (setq i (vl-string-search old tmp))
(setq out (strcat out (vl-string-subst new old (substr tmp 1 (+ i (strlen old))))))
(setq tmp (substr tmp (1+ (+ i (strlen old)))))
)
(if (zerop (strlen tmp))
out
(strcat out tmp)
)
)
(textstring)
)
)
(vl-load-com)
;; More refined filter
(if (setq ss (ssget "_X"
(list '(-4 . "<OR")
'(-4 . "<AND")
;; *text that only has part of the search string
'
(0 . "MTEXT,TEXT")
(cons 1 (strcat "*" patt "*"))
'(-4 . "AND>")
'(-4 . "<AND")
;; Attributed blocks
'
(0 . "INSERT")
'(66 . 1)
'(-4 . "AND>")
;; Dimension DUH :)
'
(-4 . "<AND")
'(0 . "DIMENSION")
'(-4 . "AND>")
'(-4 . "OR>")
)
)
)
(progn
;;(vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
(setq n -1)
(while (setq e (ssname ss (setq n (1+ n))))
(setq el (entget e))
(setq obj (vlax-ename->vla-object e))
(cond ((wcmatch (cdr (assoc 0 el)) "TEXT,MTEXT")
(setq str (cdr (assoc 1 el)))
(vla-put-textstring obj (_replacetext newpatt patt str))
)
((= (cdr (assoc 0 el)) "DIMENSION")
(and (wcmatch (strcase (setq str (cdr (assoc 1 el)))) (strcat "*" patt "*"))
(vla-put-textoverride obj (_replacetext newpatt patt str))
)
)
(t
(foreach x (vlax-invoke obj 'getattributes)
(and (wcmatch (strcase (setq str (vla-get-textstring x))) (strcat "*" patt "*"))
(vla-put-textstring x (_replacetext newpatt patt str))
)
)
)
)
)
;;(vla-endundomark adoc)
)
(princ "\nNo Text entities found!")
)
(princ)
)
(txtfind "AI1" "FAI1")
(txtfind "AI2" "FAI2")
(txtfind "AI3" "FAI3")
(txtfind "AI4" "FAI4")
(txtfind "AO1" "FAO1")
(txtfind "AO2" "FAO2")
(txtfind "AO3" "FAO3")
(txtfind "AO4" "FAO4")
(txtfind "DI1" "FDI1")
(txtfind "DI2" "FDI2")
(txtfind "DI3" "FDI3")
(txtfind "DI4" "FDI4")
(txtfind "DO1" "FDO1")
(txtfind "DO2" "FDO2")
(txtfind "DO3" "FDO3")
(txtfind "DO4" "FDO4")
Would this help at all Mike?Funny story...
http://lee-mac.com/bfind.html (http://lee-mac.com/bfind.html)
Would this help at all Mike?Funny story...
http://lee-mac.com/bfind.html (http://lee-mac.com/bfind.html)
The short version: Yes, it helps! :lol: