;;; --------------------------------------------------------------------------- ;;; TextSweep.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; FIND AND REPLACE TEXT ACROSS A WHOLE FOLDER OF DRAWINGS ;;; ;;; Build a list of find-and-replace pairs, point at a folder, and TextSweep ;;; applies every one of them to every drawing it finds -- without opening a ;;; single drawing in the editor. ;;; ;;; This is the project renamed at stage four, the consultant who changed ;;; their company name, the revision letter that has to move from A to B on ;;; two hundred sheets. AutoCAD's own FIND works in one drawing, one search ;;; term at a time. ;;; ;;; --------------------------------------------------------------------------- ;;; WHAT IS SEARCHED ;;; ;;; Every text-bearing object type, each switchable in the Options dialog: ;;; ;;; Single-line text Multiline text Block attributes ;;; Dimension text Multileader text Table cells ;;; Block definitions (the text inside block definitions themselves, ;;; which changes every insertion at once) ;;; ;;; And a choice of where: the whole drawing, model space only, or layouts ;;; only. ;;; ;;; --------------------------------------------------------------------------- ;;; FORMATTING IS PRESERVED ;;; ;;; This is the hard part, and the reason a plain string substitution is not ;;; good enough. ;;; ;;; Mtext stores its formatting inline: "{\C1;RED} text" is four visible ;;; characters of colour code wrapped round the word. Searching for "text" ;;; naively would match inside a font name; replacing across a formatting ;;; code would destroy it and leave raw codes on screen. ;;; ;;; TextSweep therefore does the search against a MASKED copy of the string. ;;; Every formatting code, brace and escape is first identified by regular ;;; expression and replaced, character for character, with a placeholder ;;; character that cannot appear in real text. The search then runs on that ;;; masked copy -- so it can never match inside a code -- but the positions ;;; it finds are used to edit the ORIGINAL string, which still has all its ;;; formatting intact. ;;; ;;; Because the mask is the same length as what it replaced, every position ;;; found in the masked copy is the correct position in the original. ;;; ;;; --------------------------------------------------------------------------- ;;; SEARCH OPTIONS ;;; ;;; Match case off by default ;;; Whole words only wraps the search in word boundaries ;;; Ignore locked layers skips objects you could not edit by hand ;;; ;;; Every character the regular expression engine treats as special is ;;; escaped before searching, so a search for "A(1)" finds exactly that ;;; rather than being read as a pattern. ;;; ;;; --------------------------------------------------------------------------- ;;; SEARCH ONLY ;;; ;;; Tick Search Only and nothing is changed: TextSweep reports what it WOULD ;;; have replaced, as a CSV listing every drawing, the old and new strings, ;;; the object type and its handle. Run it before the real thing, every time. ;;; ;;; A report can also be generated on a real run, and opens automatically. ;;; ;;; --------------------------------------------------------------------------- ;;; SAVED SEARCHES ;;; ;;; A list of find-and-replace pairs can be saved under a name and loaded ;;; again later, which turns a company-wide renaming into a one-click job on ;;; every project it affects. ;;; ;;; --------------------------------------------------------------------------- ;;; IMPORTANT -- READ BEFORE RUNNING ;;; ;;; Drawings are modified and SAVED without being opened, and there is no ;;; undo across files. ;;; ;;; Run it with Search Only first, read the report, and only then run it for ;;; real. Test on a copy of the folder. Every time. ;;; ;;; A drawing that is already open in this AutoCAD session is edited through ;;; its live document rather than through the file, so unsaved work is not ;;; lost -- but it is left unsaved, for you to review and save yourself. ;;; ;;; --------------------------------------------------------------------------- ;;; TEXTSWEEP - batch find and replace across drawings ;;; --------------------------------------------------------------------------- (vl-load-com) ;;; --------------------------------------------------------------------------- ;;; The placeholder character used to mask formatting codes during the ;;; search. Character 208 is chosen because it cannot appear in ordinary ;;; drawing text. ;;; --------------------------------------------------------------------------- (setq *TextSweep:Mask* (chr 208)) ;;; --------------------------------------------------------------------------- ;;; Option bit values. One integer holds every checkbox in the Options ;;; dialog, which is what allows the whole settings block to be saved as a ;;; single number. ;;; ;;; 1 match case 32 block attributes ;;; 2 ignore locked layers 64 dimension text ;;; 4 whole words only 128 multileader text ;;; 8 single-line text 256 table text ;;; 16 multiline text 512 always generate a report ;;; 1024 block definitions ;;; --------------------------------------------------------------------------- ;;; --------------------------------------------------------------------------- ;;; TextSweep:FixDir ;;; ;;; Normalises a folder path: forward slashes become backslashes and any ;;; trailing backslash is removed. ;;; --------------------------------------------------------------------------- (defun TextSweep:FixDir ( dir ) (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir)) ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:SavePath ;;; ;;; Where the settings and saved-search files live. The chain always ;;; succeeds, so nothing has to treat "nowhere to write" as a failure. ;;; --------------------------------------------------------------------------- (defun TextSweep:SavePath ( / dir ) (cond ( (and (setq dir (getvar 'roamablerootprefix)) (vl-file-directory-p (strcat (TextSweep:FixDir dir) "\\Support")) ) (strcat (TextSweep:FixDir dir) "\\Support") ) ( (setq dir (findfile "acad.pat")) (TextSweep:FixDir (vl-filename-directory dir)) ) ( (TextSweep:FixDir (vl-filename-directory (vl-filename-mktemp)))) ) ) ;;; =========================================================================== ;;; R E G U L A R E X P R E S S I O N E N G I N E ;;; =========================================================================== ;;; ;;; The Windows VBScript regular expression engine, held on the LISP ;;; blackboard so it survives across the namespaces AutoCAD uses for ;;; different drawings and is created only once per session. ;;; --------------------------------------------------------------------------- (defun TextSweep:RegExp ( / obj ) (cond ( (vl-bb-ref '*TextSweep:Rex*)) ( (setq obj (vl-catch-all-apply 'vlax-create-object '("VBScript.RegExp"))) (if (vl-catch-all-error-p obj) (progn (princ "\nUnable to reach the regular expression engine.") nil ) (progn (vl-bb-set '*TextSweep:Rex* obj) obj) ) ) ) ) (defun TextSweep:ReleaseRegExp ( / obj ) (if (and (setq obj (vl-bb-ref '*TextSweep:Rex*)) (= 'vla-object (type obj)) (not (vlax-object-released-p obj)) ) (vl-catch-all-apply 'vlax-release-object (list obj)) ) (vl-bb-set '*TextSweep:Rex* nil) (princ) ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:Sub ;;; ;;; Replaces every match of a pattern in a string. ;;; ;;; new - the replacement text; $1, $2 and so on refer to captured groups ;;; pat - the regular expression ;;; str - the string to work on ;;; --------------------------------------------------------------------------- (defun TextSweep:Sub ( new pat str / rex ) (setq rex (TextSweep:RegExp)) (vlax-put rex 'pattern pat) (vlax-put rex 'global actrue) (vlax-put rex 'ignorecase acfalse) (vlax-invoke rex 'replace str new) ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:Match ;;; ;;; Returns every match of a pattern in a string, as a list of ;;; (matched-text position) pairs. Positions are zero-based. ;;; ;;; pat - the regular expression ;;; str - the string to search ;;; case - non-nil for a case-sensitive search ;;; --------------------------------------------------------------------------- (defun TextSweep:Match ( pat str case / lst rex ) (setq rex (TextSweep:RegExp)) (vlax-put rex 'pattern pat) (vlax-put rex 'global actrue) (vlax-put rex 'ignorecase (if case acfalse actrue)) (vlax-for m (vlax-invoke rex 'execute str) (setq lst (cons (list (vlax-get m 'value) (vlax-get m 'firstindex)) lst)) ) lst ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:ReplaceInString ;;; ;;; The heart of the program: replaces every occurrence of one string with ;;; another inside a piece of drawing text, without disturbing its ;;; formatting. ;;; ;;; The method, step by step: ;;; ;;; 1. Park the three characters that mean something to both mtext and the ;;; regular expression engine -- the escaped backslash and the two ;;; escaped braces -- as unique placeholder tokens, so nothing downstream ;;; can misread them. They are restored at the very end. ;;; ;;; 2. Normalise line breaks. Text pasted in from another application ;;; carries "\n"; AutoCAD's own is "\P". ;;; ;;; 3. Take a copy of the string as it now stands. This copy is what gets ;;; edited, and it keeps all its formatting. ;;; ;;; 4. Build a MASKED version: find every mtext formatting code with a ;;; regular expression -- oblique, height, colour, alignment, font, ;;; overline, underline, width, tracking, stacking, line feed, ;;; paragraph, tabs, and the %%u / %%o codes of plain text -- and ;;; replace each one, CHARACTER FOR CHARACTER, with the placeholder ;;; character. Braces are masked too. ;;; ;;; Because the mask is exactly as long as what it replaced, every ;;; position in the masked string is also the correct position in the ;;; original. ;;; ;;; 5. Escape every regular-expression metacharacter in the search string, ;;; so a search for "A(1)" means those five characters and not a ;;; capturing group. ;;; ;;; 6. Search the MASKED string. Matches can never land inside a formatting ;;; code, because those are now all placeholder characters. ;;; ;;; 7. Apply the replacements to the ORIGINAL copy at the positions found, ;;; working forwards and tracking how far the string has shifted as its ;;; length changes. ;;; ;;; 8. Restore the parked characters from step 1. ;;; ;;; Search string characters are additionally interleaved with the ;;; placeholder in step 5's preparation, so that a search term can still be ;;; found when AutoCAD has split it with a formatting code in the middle. ;;; ;;; new - replacement string ;;; old - string to find ;;; str - the text to search ;;; case - non-nil for case-sensitive ;;; whole - non-nil to match whole words only ;;; ;;; Returns the new text. Sets *TextSweep:Changed* if anything was replaced. ;;; --------------------------------------------------------------------------- (defun TextSweep:ReplaceInString ( new old str case whole / brace1 brace2 codes hits masked offset orig origlen res slash stamp ) ;; ---- 1. park the escaped characters ----------------------------------- ;; The tokens embed part of the current date and time so they cannot ;; collide with anything genuinely present in the text. (setq stamp (substr (rtos (getvar 'cdate) 2 8) 14) slash (strcat "<" stamp ">") brace1 (strcat "") brace2 (strcat "<" stamp "R>") ) (setq str (TextSweep:Sub slash "\\\\\\\\" str)) (setq str (TextSweep:Sub brace1 "\\\\{" str)) (setq str (TextSweep:Sub brace2 "\\\\}" str)) ;; ---- 2. normalise line breaks ----------------------------------------- (setq str (TextSweep:Sub "\\P" "\\n" str)) ;; ---- 3. keep the formatted original ------------------------------------ (setq orig str masked str ) ;; ---- prepare the search string ---------------------------------------- ;; Each character of the search term is separated by a placeholder and a ;; wildcard, so the term is still found when AutoCAD has split it across ;; a formatting code. ( (lambda ( chars / built ) (foreach c (cdr (reverse chars)) (setq built (cons c (cons 208 (cons 42 built)))) ) (setq old (vl-list->string (append built (list (last chars))))) ) (vl-string->list old) ) ;; ---- 4. mask every formatting code ------------------------------------- ;; Each pattern below matches one kind of inline code. They are collected ;; first and masked afterwards, because masking as we go would change the ;; positions of everything after it. (setq codes (apply 'append (mapcar '(lambda ( pat ) (TextSweep:Match pat masked t)) '( "\\\\Q[-]?[0-9]*?[.]?[0-9]+;" ;; oblique angle "\\\\H[0-9]?[.]?[0-9]+x;" ;; height "\\\\[Cc][0-9]?[.]?[0-9]+;" ;; colour "\\\\A[012];" ;; alignment "\\\\[Ff].*?;" ;; font "\\\\[Oo]" ;; overline "\\\\[Ll]" ;; underline "\\\\W[0-9]?[.]?[0-9]+;" ;; width "\\\\T[0-9]?[.]?[0-9]+;" ;; tracking "\\\\S.*?;" ;; stacked fraction "\\\\P" ;; line feed "\\\\p.*?;" ;; paragraph "\\\\P\\t|[0-9]+;\\t|\\t" ;; tabs "%%[uUoO]" ;; plain text under/overline ) ) ) ) ;; Replace each code with the same number of placeholder characters, so ;; positions in the masked string still match the original. (foreach code codes (setq masked (vl-string-subst (TextSweep:Sub *TextSweep:Mask* "(.)" (car code)) (car code) masked (cadr code) ) ) ) (setq masked (TextSweep:Sub *TextSweep:Mask* "{|}" masked)) ;; ---- 5. escape the search string --------------------------------------- (foreach pat '("\\\\" "\\^" "\\$" "\\+" "\\?" "\\." "\\(" "\\)" "\\|" "\\{" "\\}" "\\," "\\[" "\\]") (setq old (TextSweep:Sub pat pat old)) ) ;; Asterisks are escaped too, except the ones this program inserted ;; itself between the search characters above -- those are recognised by ;; the placeholder that precedes them. (setq old (TextSweep:Sub "$1\\*" (strcat "([^" *TextSweep:Mask* "]|^)\\*") old)) ;; ---- 6. search the masked string --------------------------------------- ;; The hits are reversed so they come out in forward order, and each ;; records the ORIGINAL text at that position rather than the masked ;; text, because the original is what will be substituted out. (foreach hit (reverse (TextSweep:Match (if whole (strcat "\\b" old "\\b") old) masked case)) (setq hits (cons (list (substr orig (1+ (cadr hit)) (strlen (car hit))) (cadr hit)) hits)) ) ;; ---- 7. apply the replacements ------------------------------------------ ;; Working forwards, each replacement shifts everything after it by the ;; difference in length, which the running offset accounts for. (setq origlen (strlen orig) offset 0 ) (foreach hit (reverse hits) (setq *TextSweep:Changed* t) (setq res (vl-string-subst new (car hit) orig (+ offset (cadr hit))) orig res offset (- (strlen res) origlen) ) ) (if (null res) (setq res orig)) ;; ---- 8. restore the parked characters ----------------------------------- (setq res (TextSweep:Sub "\\\\" slash res) res (TextSweep:Sub "\\{" brace1 res) res (TextSweep:Sub "\\}" brace2 res) ) res ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:ReplaceAll ;;; ;;; Applies every find-and-replace pair in turn to one string. ;;; --------------------------------------------------------------------------- (defun TextSweep:ReplaceAll ( pairs str case whole ) (foreach pair pairs (setq str (TextSweep:ReplaceInString (cdr pair) (car pair) str case whole)) ) str ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:GetText ;;; ;;; Returns the text content of an object, whatever kind it is. ;;; ;;; MText and attributes store strings longer than 250 characters split ;;; across a series of DXF group 3 entries with the tail in group 1, so those ;;; have to be reassembled -- reading group 1 alone would silently truncate a ;;; long note and then write the truncation back. ;;; --------------------------------------------------------------------------- (defun TextSweep:GetText ( ent / enx itm str typ ) (if (= 'vla-object (type ent)) (setq ent (vlax-vla-object->ename ent)) ) (setq enx (entget ent) typ (cdr (assoc 0 enx)) ) (cond ( (wcmatch typ "TEXT,*DIMENSION") (cdr (assoc 1 enx)) ) ;; Group 172 says whether a multileader holds text or a block; only ;; text content is searchable here. ( (and (= "MULTILEADER" typ) (= acmtextcontent (cdr (assoc 172 (reverse enx)))) ) (cdr (assoc 304 enx)) ) ( (wcmatch typ "ATTRIB,MTEXT") (setq enx (reverse enx) str (cdr (assoc 1 enx)) ) (while (setq itm (assoc 3 enx)) (setq str (strcat (cdr itm) str) enx (cdr (member itm enx)) ) ) str ) ) ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:NewInsPoint ;;; ;;; Returns the insertion point a single-line text object needs so that it ;;; stays visually put after its content changes length. ;;; ;;; TEXT is anchored at its insertion point, but a centred or right-justified ;;; object grows away from that anchor in the wrong direction. The width ;;; difference between the old and new strings is measured with textbox, and ;;; the anchor moved by half of it for centre and middle justification, all ;;; of it for right, and none for left. ;;; ;;; obj - the text object ;;; str - the new string ;;; --------------------------------------------------------------------------- (defun TextSweep:NewInsPoint ( obj str / enx just ) (setq enx (entget (vlax-vla-object->ename obj)) just (cdr (assoc 72 enx)) ) (polar (vlax-get obj 'insertionpoint) (vla-get-rotation obj) (* ;; Width of the old string less the width of the new one. (apply '+ (mapcar '(lambda ( a b ) (- (car a) (car b))) (textbox enx) (textbox (subst (cons 1 str) (assoc 1 enx) enx)) ) ) (cond ;; 1 = centre, 4 = middle: move by half. ( (or (= 1 just) (= 4 just)) 0.5) ;; 2 = right: move by all of it. ( (= 2 just) 1.0) ;; Left and everything else: not at all. ( 0.0) ) ) ) ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:ProcessObject ;;; ;;; Examines one object and, if its text changes, records the change and ;;; optionally writes it back. ;;; ;;; dwg - drawing name, for the report ;;; obj - the object ;;; pairs - the find-and-replace list ;;; bits - the option bit field ;;; locked - upper-cased names of layers that were locked ;;; apply - non-nil to actually write the change; nil for search only ;;; --------------------------------------------------------------------------- (defun TextSweep:ProcessObject ( dwg obj pairs bits locked apply / cls new old ) (setq cls (vla-get-objectname obj)) ;; Objects on a locked layer are skipped when that option is set. (if (not (and (= 2 (logand 2 bits)) (vl-position (strcase (vla-get-layer obj)) locked) ) ) (cond ;; ---- block attributes ---- ( (and (= "AcDbBlockReference" cls) (= :vlax-true (vla-get-hasattributes obj)) (= 32 (logand 32 bits)) ) (foreach att (vlax-invoke obj 'getattributes) (if (/= (setq old (TextSweep:GetText att)) (setq new (TextSweep:ReplaceAll pairs old (= 1 (logand 1 bits)) (= 4 (logand 4 bits)))) ) (progn (setq *TextSweep:Report* (cons (list dwg old new "Attribute" (vl-prin1-to-string (vla-get-handle att)) (vla-get-tagstring att)) *TextSweep:Report*) ) (if apply (progn (vla-put-insertionpoint att (vlax-3d-point (TextSweep:NewInsPoint att new))) (vla-put-textstring att new) ) ) ) ) ) ) ;; ---- dimension text ---- ;; Only an overridden dimension has text of its own; an empty ;; group 1 means it is showing its measured value, which cannot ;; meaningfully be replaced. ( (and (wcmatch (strcase cls) "*DIMENSION*") (= 64 (logand 64 bits)) ) (if (and (/= "" (setq old (TextSweep:GetText obj))) (/= old (setq new (TextSweep:ReplaceAll pairs old (= 1 (logand 1 bits)) (= 4 (logand 4 bits))))) ) (progn (setq *TextSweep:Report* (cons (list dwg old new "Dimension" (vl-prin1-to-string (vla-get-handle obj))) *TextSweep:Report*) ) (if apply (vla-put-textoverride obj new)) ) ) ) ;; ---- text, mtext and multileaders ---- ( (or (and (= "AcDbMText" cls) (= 16 (logand 16 bits))) (and (= "AcDbText" cls) (= 8 (logand 8 bits))) (and (= "AcDbMLeader" cls) (= 128 (logand 128 bits))) ) (if (and (setq old (TextSweep:GetText obj)) (/= old (setq new (TextSweep:ReplaceAll pairs old (= 1 (logand 1 bits)) (= 4 (logand 4 bits))))) ) (progn (setq *TextSweep:Report* (cons (list dwg old new (cdr (assoc cls '(("AcDbMText" . "MText") ("AcDbText" . "Text") ("AcDbMLeader" . "Multileader")))) (vl-prin1-to-string (vla-get-handle obj))) *TextSweep:Report*) ) (if apply (progn ;; Only single-line text needs its anchor ;; adjusted; mtext and multileaders reflow ;; within their own frames. (if (= "AcDbText" cls) (vla-put-insertionpoint obj (vlax-3d-point (TextSweep:NewInsPoint obj new))) ) (vla-put-textstring obj new) ) ) ) ) ) ;; ---- table cells ---- ;; Walked backwards from the last row and column, which avoids ;; having to ask the table for its size on every iteration. ( (and (= "AcDbTable" cls) (= 256 (logand 256 bits))) ( (lambda ( row ) (while (not (minusp (setq row (1- row)))) ( (lambda ( col ) (while (not (minusp (setq col (1- col)))) (if (/= (setq old (vla-gettext obj row col)) (setq new (TextSweep:ReplaceAll pairs old (= 1 (logand 1 bits)) (= 4 (logand 4 bits)))) ) (progn (setq *TextSweep:Report* (cons (list dwg old new "Table" (vl-prin1-to-string (vla-get-handle obj))) *TextSweep:Report*) ) (if apply (vla-settext obj row col new)) ) ) ) ) (vla-get-columns obj) ) ) ) (vla-get-rows obj) ) ) ) ) (princ) ) ;;; =========================================================================== ;;; TEXTSWEEP ;;; =========================================================================== (defun c:TextSweep ( / ;; ---- nested helper functions ---- *error* TextSweep:Restore TextSweep:FillList TextSweep:ShowPath TextSweep:FolderMode TextSweep:ShowPairs TextSweep:Options TextSweep:EditEntry TextSweep:SaveAs TextSweep:LoadList TextSweep:Confirm TextSweep:Report ;; ---- settings, stored in the configuration file ---- TS:Pairs TS:Path TS:Cur TS:Open TS:Sub TS:Bits TS:Search TS:Where ;; ---- working variables ---- acapp acdoc cfg curdir dbdoc dch dcl des doc dwgs err findstr flag ftmp items opened progress ptr ref repstr saved savefile syms tmp vals values vars ) (setq vars '("CMDECHO") vals (mapcar 'getvar vars) ) ;;; ----------------------------------------------------------------------- ;;; TextSweep:Restore ;;; ;;; Closes the progress bar, releases every COM object, unloads the ;;; dialog and deletes its temporary file. ;;; ;;; Releasing matters: an unreleased ObjectDBX document keeps a handle on ;;; the last drawing it touched, which can leave that file locked until ;;; AutoCAD closes. ;;; ----------------------------------------------------------------------- (defun TextSweep:Restore ( ) (if (= 'file (type des)) (close des)) (if (and progress (vl-position "acetutil.arx" (arx))) (vl-catch-all-apply 'acet-ui-progress) ) (if (and (= 'int (type dch)) (< 0 dch)) (unload_dialog dch)) (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl)) (foreach obj (list dbdoc) (if (and obj (= 'vla-object (type obj)) (not (vlax-object-released-p obj))) (vl-catch-all-apply 'vlax-release-object (list obj)) ) ) (TextSweep:ReleaseRegExp) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark acdoc) ) (mapcar 'setvar vars vals) ;; Three collections: COM objects are only truly released once nothing ;; refers to them, and a single pass often leaves one behind. (gc) (gc) (princ) ) (defun *error* ( msg ) (TextSweep:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** TEXTSWEEP error: " msg " **")) ) (princ) ) ;;; ----------------------------------------------------------------------- ;;; Dialog helpers. ;;; ----------------------------------------------------------------------- (defun TextSweep:FillList ( key lst ) (start_list key) (foreach x lst (add_list x)) (end_list) (princ) ) ;; Shows a path, shortened with an ellipsis if it is too long for the ;; tile. Without this a deep network path runs off the edge of the dialog ;; and the useful end of it is invisible. (defun TextSweep:ShowPath ( key str ) (set_tile key (cond ( (null str) "") ( (< 40 (strlen str)) (strcat (substr str 1 37) "...")) ( str) ) ) ) ;; Greys the folder controls when a single drawing or the open drawings ;; are the target, since the folder then plays no part. (defun TextSweep:FolderMode ( cur opn / val ) (setq val (if (or (= "1" cur) (= "1" opn)) 1 0)) (foreach key (cond ( (= "1" cur) '("opn_dwg" "cur_dir" "sub_dir" "dir" "dir_text")) ( (= "1" opn) '("cur_dwg" "cur_dir" "sub_dir" "dir" "dir_text")) ( '("opn_dwg" "cur_dwg" "cur_dir" "sub_dir" "dir" "dir_text")) ) (mode_tile key val) ) (princ) ) ;; Fills the find-and-replace list. The two columns are separated by a ;; tab, which the list box turns into an aligned column; long search ;; strings are truncated so the second column stays where it is. (defun TextSweep:ShowPairs ( key lst ) (start_list key) (foreach pair lst (add_list (strcat (if (< 29 (strlen (car pair))) (strcat (substr (car pair) 1 26) "...") (car pair) ) "\t" (cdr pair) ) ) ) (end_list) lst ) ;;; ----------------------------------------------------------------------- ;;; TextSweep:Confirm ;;; ;;; A simple yes/no question. Returns T for yes. ;;; ;;; Implemented as a DCL dialog rather than a Windows message box, which ;;; avoids creating and releasing a COM object for every confirmation. ;;; ----------------------------------------------------------------------- (defun TextSweep:Confirm ( msg / ok ) (if (not (new_dialog "ts_confirm" dch)) nil (progn (set_tile "ctext" msg) (action_tile "accept" "(setq ok t) (done_dialog)") (action_tile "cancel" "(done_dialog)") (start_dialog) ok ) ) ) ;;; ----------------------------------------------------------------------- ;;; TextSweep:Options ;;; ;;; The options dialog. Returns (bits where). ;;; ;;; Each checkbox owns one bit of a single integer, and its callback adds ;;; or subtracts that bit. The bit value is baked into the callback string ;;; as a literal, so the counter is evaluated when the callbacks are set ;;; up rather than when they fire. ;;; ----------------------------------------------------------------------- (defun TextSweep:Options ( bits where / bit newbits newwhere ) (if (not (new_dialog "ts_options" dch)) (progn (princ "\nUnable to open the options dialog.") (list bits where)) (progn (TextSweep:FillList "where" '("Entire Drawing" "Model Space Only" "Layout Space Only")) (setq newbits bits newwhere where bit 1 ) (foreach key '("case" "lock" "whol" "dtxt" "mtxt" "att" "dim" "mld" "tab" "report" "blk") (set_tile key (if (= bit (logand bit newbits)) "1" "0")) (action_tile key (strcat "(setq newbits ((if (= \"1\" $value) + -) newbits " (itoa bit) "))")) (setq bit (lsh bit 1)) ) (set_tile "where" newwhere) (action_tile "where" "(setq newwhere $value)") (action_tile "accept" "(setq bits newbits where newwhere) (done_dialog)") (action_tile "cancel" "(done_dialog)") (start_dialog) (list bits where) ) ) ) ;;; ----------------------------------------------------------------------- ;;; TextSweep:EditEntry ;;; ;;; Edits one find-and-replace pair, opened by double-clicking it. ;;; ----------------------------------------------------------------------- (defun TextSweep:EditEntry ( entry / fs rs ) (if (not (new_dialog "ts_edit" dch)) (progn (princ "\nUnable to open the edit dialog.") entry) (progn (setq fs (set_tile "fstr" (car entry)) rs (set_tile "rstr" (cdr entry)) ) (mode_tile "fstr" 2) (action_tile "fstr" "(setq fs $value)") (action_tile "rstr" "(setq rs $value)") (action_tile "accept" (vl-prin1-to-string '(if (or (null fs) (= "" fs)) (alert "Please enter something to find.") (progn (setq entry (cons fs rs)) (done_dialog)) ) ) ) (action_tile "cancel" "(done_dialog)") (start_dialog) entry ) ) ) ;;; ----------------------------------------------------------------------- ;;; TextSweep:SaveAs ;;; ;;; Asks for a name to save the current list under. Returns the name, or ;;; nil if cancelled. ;;; ----------------------------------------------------------------------- (defun TextSweep:SaveAs ( existing / str ) (if (not (new_dialog "ts_save" dch)) (progn (princ "\nUnable to open the save dialog.") nil) (progn (action_tile "saveas" "(setq str $value)") (action_tile "accept" (vl-prin1-to-string '(cond ( (or (null str) (= "" str)) (alert "Please enter a name to save under.") ) ( (member str existing) (if (TextSweep:Confirm "That name already exists. Overwrite it?") (done_dialog) ) ) ( (done_dialog)) ) ) ) (action_tile "cancel" "(setq str nil) (done_dialog)") (start_dialog) str ) ) ) ;;; ----------------------------------------------------------------------- ;;; TextSweep:LoadList ;;; ;;; Lists the saved searches and lets one be loaded or deleted. ;;; ;;; Returns (chosen-name remaining-names), so the caller learns both what ;;; was picked and what deletions were made in the same visit. ;;; ----------------------------------------------------------------------- (defun TextSweep:LoadList ( names / chosen at ) (if (not (new_dialog "ts_load" dch)) (progn (princ "\nUnable to open the load dialog.") (list nil names)) (progn (TextSweep:FillList "items" (setq names (acad_strlsort names))) (setq at (set_tile "items" "0")) (action_tile "items" "(setq at $value)") (action_tile "delete" (vl-prin1-to-string '(cond ( (null at) (alert "Select a saved search to delete.") ) ( (TextSweep:Confirm (strcat "Delete the saved search \"" (nth (atoi at) names) "\"? This cannot be undone.")) (setq names (TextSweep:RemoveNth (list (atoi at)) names)) (TextSweep:FillList "items" names) (if names (setq at (set_tile "items" (if (< (atoi at) (length names)) at "0"))) (progn (setq at nil) (mapcar 'mode_tile '("delete" "accept") '(1 1)) ) ) ) ) ) ) (action_tile "accept" (vl-prin1-to-string '(if (null at) (alert "Select a saved search to load.") (progn (setq chosen (nth (atoi at) names)) (done_dialog)) ) ) ) (start_dialog) (list chosen names) ) ) ) ;;; ----------------------------------------------------------------------- ;;; TextSweep:Report ;;; ;;; Writes the CSV report. ;;; ;;; Opened for append, so running the sweep more than once in a day adds ;;; to the same file rather than losing the earlier record -- which is ;;; what you want when the report is the audit trail. ;;; ----------------------------------------------------------------------- (defun TextSweep:Report ( file data / out ) (if (setq out (open file "a")) (progn (write-line (strcat "Replacement Report," (menucmd "m=$(edtime,$(getvar,DATE),DD.MO.YYYY HH:MM)") (if (= "1" TS:Search) ",SEARCH ONLY" "")) out ) (write-line "" out) (foreach pair (cons '("Search String" . "Replace String") TS:Pairs) (write-line (strcat (car pair) "," (cdr pair)) out) ) (write-line "" out) (write-line (strcat "Parent Folder," TS:Path) out) (write-line "" out) ;; The tag column only appears when at least one attribute ;; was found, so an ordinary text run does not get an empty ;; column. (write-line (strcat "Drawing,Old String,New String,Object,Handle" (if (vl-some '(lambda ( x ) (= 6 (length x))) data) ",Tag" "")) out ) (foreach row data (write-line (TextSweep:Join row ",") out) ) (write-line "" out) (write-line (strcat "Total Replacements:," (itoa (length data))) out) (write-line "" out) (close out) t ) ) ) ;;; ======================================================================= ;;; M A I N R O U T I N E ;;; ======================================================================= (setvar 'cmdecho 0) (setq acapp (vlax-get-acad-object) acdoc (vla-get-activedocument acapp) curdir (vl-string-right-trim "\\" (getvar 'dwgprefix)) cfg (strcat (TextSweep:SavePath) "\\YZ_TextSweep.cfg") savefile (strcat (TextSweep:SavePath) "\\YZ_TextSweep_Searches.txt") ) ;; Index every open document, so drawings the user has on screen are ;; edited live rather than through the copy on disk. (vlax-for doc (vla-get-documents acapp) (setq opened (cons (cons (strcase (TextSweep:DocPath doc)) doc) opened) ) ) ;; ---- load the settings -------------------------------------------------- ;; The default bit field switches on match case, all the ordinary text ;; object types, and report generation. (setq syms '(TS:Pairs TS:Path TS:Cur TS:Open TS:Sub TS:Bits TS:Search TS:Where) values (list nil curdir "0" "0" "1" (+ 1 8 16 32 64 128 256 512) "0" "0") ) (if (not (findfile cfg)) (TextSweep:WriteConfig cfg values)) (TextSweep:ReadConfig cfg syms) (mapcar '(lambda ( sym val ) (or (boundp sym) (set sym val))) syms values) (setq saved (TextSweep:ReadSearches savefile)) ;; ---- build the dialog --------------------------------------------------- (cond ( (not (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w")) (progn (foreach line '( "boxcol : boxed_column { width = 60; fixed_width = true; alignment = centered; }" "edit53 : edit_box { width = 53; fixed_width = true; alignment = left; }" "space1 : spacer { height = 0.1; fixed_height = true; }" "butt10 : button { width = 10; fixed_width = true; alignment = centered; }" "butt12 : button { width = 12; fixed_width = true; alignment = centered; }" "butt20 : button { width = 20; fixed_width = true; alignment = centered; }" "butt3 : button { width = 3; fixed_width = true; alignment = centered; }" "" "bfind : dialog { label = \"Text Sweep - Batch Find and Replace\";" " spacer;" " : column {" " : text { label = \"Find &what:\"; }" " : row {" " : edit53 { key = \"fstr\"; mnemonic = \"W\"; }" " : butt3 { key = \"fpick\"; label = \">>\"; is_tab_stop = false; }" " }" " spacer;" " : text { label = \"&Replace with:\"; }" " : row {" " : edit53 { key = \"rstr\"; mnemonic = \"R\"; }" " : butt3 { key = \"rpick\"; label = \">>\"; is_tab_stop = false; }" " }" " : toggle { key = \"search\"; label = \"Search only - change nothing\";" " is_tab_stop = false; }" " spacer;" " }" " spacer;" " : row {" " spacer;" " : butt20 { key = \"add\"; label = \"Add\"; }" " : butt10 { key = \"clr\"; label = \"Clear\"; }" " : butt20 { key = \"rem\"; label = \"Remove\"; }" " spacer;" " }" " spacer;" " : list_box { key = \"rep_list\"; multiple_select = true;" " fixed_width = false; alignment = centered; tabs = \"30\"; }" " spacer;" " : row { alignment = centered; fixed_width = true;" " : butt20 { key = \"load\"; label = \"Load\"; }" " : butt20 { key = \"save\"; label = \"Save\"; }" " }" " : text { label = \"Double-click an entry to edit it \"; alignment = right; }" " : boxcol { label = \"Drawing Folder\";" " : row {" " : column { space1;" " : text { key = \"dir_text\"; alignment = left; }" " space1; }" " : butt10 { label = \"Folder...\"; key = \"dir\"; }" " }" " : row {" " : column {" " : toggle { key = \"cur_dir\"; label = \"Current folder\"; }" " : toggle { key = \"sub_dir\"; label = \"Include sub-folders\"; }" " }" " : column {" " : toggle { key = \"cur_dwg\"; label = \"Current drawing only\"; }" " : toggle { key = \"opn_dwg\"; label = \"All open drawings\"; }" " }" " }" " }" " spacer;" " : row {" " : butt12 { key = \"option\"; label = \"Options\"; }" " : butt12 { key = \"accept\"; label = \"OK\"; is_default = true; }" " : butt12 { key = \"cancel\"; label = \"Cancel\"; is_cancel = true; }" " }" "}" "" "ts_options : dialog { label = \"Text Sweep Options\";" " spacer;" " : boxed_column { label = \"Search Options\";" " : row {" " : toggle { key = \"case\"; label = \" Match &case\"; mnemonic = \"C\"; }" " : toggle { key = \"whol\"; label = \" Whole &words only\"; mnemonic = \"W\"; }" " }" " : toggle { key = \"lock\"; label = \" &Ignore objects on locked layers\";" " mnemonic = \"I\"; }" " spacer;" " }" " spacer;" " : boxed_column { label = \"Objects to Search\";" " : row {" " : column {" " : toggle { key = \"dtxt\"; label = \" &Single-line text\"; mnemonic = \"S\"; }" " : toggle { key = \"mtxt\"; label = \" &Multiline text\"; mnemonic = \"M\"; }" " : toggle { key = \"att\"; label = \" &Block attributes\"; mnemonic = \"B\"; }" " : toggle { key = \"blk\"; label = \" B&lock definitions\"; mnemonic = \"l\"; }" " }" " : column {" " : toggle { key = \"dim\"; label = \" &Dimension text\"; mnemonic = \"D\"; }" " : toggle { key = \"mld\"; label = \" M&ultileader text\"; mnemonic = \"u\"; }" " : toggle { key = \"tab\"; label = \" &Table text\"; mnemonic = \"T\"; }" " : spacer { height = 1.2; fixed_height = true; }" " }" " }" " spacer;" " }" " spacer;" " : boxed_column { label = \"Report\";" " : toggle { key = \"report\"; label = \" &Always generate a report\";" " mnemonic = \"A\"; }" " spacer;" " }" " spacer;" " : boxed_column { label = \"Where to Search\";" " : popup_list { key = \"where\"; }" " spacer;" " }" " spacer; ok_cancel;" "}" "" "ts_edit : dialog { label = \"Edit Entry\";" " spacer;" " : column {" " : text { label = \"Find &what:\"; is_tab_stop = false; }" " : edit53 { key = \"fstr\"; mnemonic = \"W\"; allow_accept = true; }" " spacer;" " : text { label = \"&Replace with:\"; is_tab_stop = false; }" " : edit53 { key = \"rstr\"; mnemonic = \"R\"; allow_accept = true; }" " spacer;" " }" " spacer; ok_cancel;" "}" "" "ts_save : dialog { label = \"Save As\"; initial_focus = \"saveas\";" " spacer;" " : text { label = \"Enter a name for this list of search items:\"; }" " : edit53 { key = \"saveas\"; allow_accept = true; }" " spacer; ok_cancel;" "}" "" "ts_load : dialog { label = \"Load Saved Search\";" " spacer;" " : list_box { key = \"items\"; alignment = centered; fixed_width = true;" " multiple_select = false; width = 50; }" " spacer;" " : row { fixed_width = true; alignment = centered;" " : butt12 { label = \"Load\"; key = \"accept\"; is_default = true; }" " : butt12 { label = \"Done\"; key = \"cancel\"; is_cancel = true; }" " : butt12 { label = \"Delete\"; key = \"delete\"; }" " }" "}" "" "ts_confirm : dialog { label = \"Confirm\";" " spacer;" " : text { key = \"ctext\"; alignment = centered; label = \" \"; }" " spacer; ok_cancel;" "}" ) (write-line line des) ) (setq des (close des)) (< 0 (setq dch (load_dialog dcl))) ) ) ) (princ "\nUnable to create the dialog.") ) ( t ;; ---- the dialog loop ------------------------------------------ ;; The dialog reopens after the two "pick from screen" buttons, ;; which must close it to let the user reach the drawing. (while (not (member flag '(0 1))) (if (not (new_dialog "bfind" dch)) (progn (princ "\nUnable to display the dialog.") (setq flag 0)) (progn (if findstr (set_tile "fstr" findstr)) (if repstr (set_tile "rstr" repstr)) (set_tile "sub_dir" TS:Sub) (set_tile "search" TS:Search) ;; A stored folder that no longer exists falls back to ;; the current drawing's folder. (TextSweep:ShowPath "dir_text" (setq TS:Path (vl-string-right-trim "\\" (if (vl-file-directory-p TS:Path) TS:Path curdir)) ) ) (TextSweep:FolderMode (set_tile "cur_dwg" TS:Cur) (set_tile "opn_dwg" TS:Open)) (if (= (strcase TS:Path) (strcase curdir)) (set_tile "cur_dir" "1") ) (TextSweep:ShowPairs "rep_list" TS:Pairs) ;;; --------------------------------------------------- ;;; Callbacks. ;;; ;;; Written as quoted lists and converted with ;;; vl-prin1-to-string, which produces correct quoting ;;; every time where hand-escaping does not. ;;; --------------------------------------------------- (action_tile "cur_dir" (vl-prin1-to-string '(if (= "1" $value) (TextSweep:ShowPath "dir_text" (setq TS:Path curdir)) ) ) ) ;; The two drawing-scope toggles exclude each other. (action_tile "cur_dwg" (vl-prin1-to-string '(progn (if (= "1" (setq TS:Cur $value)) (set_tile "opn_dwg" (setq TS:Open "0")) ) (TextSweep:FolderMode TS:Cur TS:Open) ) ) ) (action_tile "opn_dwg" (vl-prin1-to-string '(progn (if (= "1" (setq TS:Open $value)) (set_tile "cur_dwg" (setq TS:Cur "0")) ) (TextSweep:FolderMode TS:Cur TS:Open) ) ) ) (action_tile "dir" (vl-prin1-to-string '(if (setq tmp (TextSweep:PickFolder "Select the folder of drawings to process..." nil (+ 1 64 256))) (progn (TextSweep:ShowPath "dir_text" (setq TS:Path tmp)) (set_tile "cur_dir" (if (= (strcase TS:Path) (strcase curdir)) "1" "0")) ) ) ) ) (action_tile "sub_dir" "(setq TS:Sub $value)") (action_tile "search" "(setq TS:Search $value)") ;; Pressing Enter in either text box adds the pair, ;; which is quicker than reaching for the Add button. ;; $reason 1 means the field was left or Enter pressed. (action_tile "fstr" (vl-prin1-to-string '(progn (setq findstr $value) (if (= 1 $reason) (TextSweep:AddPair)) ) ) ) (action_tile "rstr" (vl-prin1-to-string '(progn (setq repstr $value) (if (= 1 $reason) (TextSweep:AddPair)) ) ) ) (action_tile "add" "(TextSweep:AddPair)") (action_tile "rem" (vl-prin1-to-string '(cond ( (null TS:Pairs) (alert "There is nothing in the list to remove.") ) ( (and ptr (listp (setq items (read (strcat "(" ptr ")"))))) (setq TS:Pairs (TextSweep:ShowPairs "rep_list" (TextSweep:SortByFirst (TextSweep:RemoveNth items TS:Pairs))) ptr nil ) ) ( (alert "Select an entry from the list to remove.")) ) ) ) ;; $reason 4 is a double-click, which edits the entry. (action_tile "rep_list" (vl-prin1-to-string '(progn (setq ptr $value) (if (and (= 4 $reason) (setq ptr (car (read (strcat "(" ptr ")")))) ) (progn (TextSweep:ShowPairs "rep_list" (setq TS:Pairs (TextSweep:SortByFirst (TextSweep:SubstNth TS:Pairs (TextSweep:EditEntry (nth ptr TS:Pairs)) ptr)))) (set_tile "rep_list" (setq ptr (itoa ptr))) ) ) ) ) ) (action_tile "clr" "(TextSweep:ShowPairs \"rep_list\" (setq TS:Pairs nil))") (action_tile "option" (vl-prin1-to-string '(setq tmp (TextSweep:Options TS:Bits TS:Where) TS:Bits (car tmp) TS:Where (cadr tmp) ) ) ) (action_tile "save" (vl-prin1-to-string '(cond ( (null TS:Pairs) (alert "Add something to the list before saving it.") ) ( (setq ref (TextSweep:SaveAs (mapcar 'car saved))) (setq saved (if (assoc ref saved) (subst (cons ref TS:Pairs) (assoc ref saved) saved) (cons (cons ref TS:Pairs) saved) ) ) (alert "Search items saved.") ) ) ) ) (action_tile "load" (vl-prin1-to-string '(cond ( (null saved) (alert "There are no saved searches.") ) ( (setq ref (TextSweep:LoadList (mapcar 'car saved))) ;; The load dialog also allows ;; deletion, so the saved list is ;; filtered to whatever survived it. (setq saved (vl-remove-if-not '(lambda ( x ) (member (car x) (cadr ref))) saved ) ) (if (car ref) (TextSweep:ShowPairs "rep_list" (setq TS:Pairs (TextSweep:SortByFirst (cdr (assoc (car ref) saved))))) ) ) ) ) ) (action_tile "fpick" "(done_dialog 2)") (action_tile "rpick" "(done_dialog 3)") (action_tile "accept" (vl-prin1-to-string '(if (null TS:Pairs) (alert "Add at least one entry to the list.") (done_dialog 1) ) ) ) (action_tile "cancel" "(done_dialog 0)") (setq flag (start_dialog)) ) ) ;; ---- pick a string from an object on screen ---- ;; nentsel rather than entsel, so an attribute inside a block ;; can be picked. (if (member flag '(2 3)) (while (progn (setvar 'errno 0) (setq tmp (car (nentsel "\nSelect object: "))) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (= 'ename (type tmp)) (if (wcmatch (cdr (assoc 0 (entget tmp))) "ATTRIB,TEXT,MTEXT,MULTILEADER") (not (set (if (= 2 flag) 'findstr 'repstr) (TextSweep:GetText tmp))) (princ "\nThat object contains no text.") ) ) ) ) ) ) ) (setq dch (unload_dialog dch)) (vl-file-delete dcl) (setq dcl nil) (TextSweep:WriteSearches savefile saved) ;;; =============================================================== ;;; D O T H E W O R K ;;; =============================================================== (if (/= 1 flag) (princ "\nCancelled.") (progn (vla-startundomark acdoc) (princ "\nWorking, please wait...") (setq dbdoc (TextSweep:DbxDocument acapp) *TextSweep:Report* nil ) ;; ---- which drawings ---------------------------------- (setq dwgs (cond ( (= "1" TS:Cur) (list (TextSweep:DocPath acdoc))) ( (= "1" TS:Open) (vlax-for doc (vla-get-documents acapp) (setq tmp (cons (TextSweep:DocPath doc) tmp)) ) tmp ) ( (TextSweep:AllFiles TS:Path (= "1" TS:Sub) "*.dwg")) ) ) ;; A progress bar, if Express Tools is available. Purely ;; cosmetic, so its absence changes nothing. (if (vl-position "acetutil.arx" (arx)) (setq progress (not (vl-catch-all-error-p (vl-catch-all-apply 'acet-ui-progress (list "Sweeping drawings..." (length dwgs))))) ) ) (foreach dwg dwgs (setq *TextSweep:Changed* nil) (princ ".") (if progress (vl-catch-all-apply 'acet-ui-progress '(-1))) (if (setq doc (cond ( (= "1" TS:Cur) acdoc) ;; Already open: edit the live document, ;; or the user's unsaved work would be ;; silently overwritten. ( (cdr (assoc (strcase dwg) opened))) ( (and dbdoc (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbdoc dwg))))) dbdoc ) ) ) ;; The whole per-drawing operation is caught, so ;; one corrupt or unusual file does not abandon ;; the rest of the run. (if (vl-catch-all-error-p (setq err (vl-catch-all-apply '(lambda ( / lockobjs locknames name ) ;; Layers are unlocked so ;; their objects can be ;; edited, but their names are ;; kept so the "ignore locked" ;; option still knows which ;; they were. (setq lockobjs (TextSweep:UnlockLayers doc) locknames (mapcar '(lambda ( l ) (strcase (vla-get-name l))) lockobjs) name (strcat (vl-filename-base dwg) ".dwg") ) ;; Layouts, filtered by the ;; "where to search" setting. (vlax-for lay (vla-get-layouts doc) (if (or (= "0" TS:Where) (and (= "1" TS:Where) (= "MODEL" (strcase (vla-get-name lay)))) (and (= "2" TS:Where) (/= "MODEL" (strcase (vla-get-name lay)))) ) (vlax-for obj (vla-get-block lay) (TextSweep:ProcessObject name obj TS:Pairs TS:Bits locknames (= "0" TS:Search)) ) ) ) ;; Block definitions, if asked ;; for. Layouts, xrefs and ;; anonymous dimension blocks ;; are skipped: the first are ;; already covered above, the ;; second belong to another ;; file, and the third are ;; regenerated by AutoCAD. (if (= 1024 (logand 1024 TS:Bits)) (vlax-for blk (vla-get-blocks doc) (if (and (= :vlax-false (vla-get-islayout blk)) (= :vlax-false (vla-get-isxref blk)) (not (wcmatch (vla-get-name blk) "`*D*")) ) (vlax-for obj blk (TextSweep:ProcessObject name obj TS:Pairs TS:Bits locknames (= "0" TS:Search)) ) ) ) ) (TextSweep:LockLayers lockobjs) ;; Save only if something ;; changed, this is not a ;; search-only run, and the ;; drawing has a file to save ;; to. An unsaved open drawing ;; is deliberately left for ;; the user to save. (if (and *TextSweep:Changed* (= "0" TS:Search) (not (and (vlax-property-available-p doc 'fullname) (= "" (vla-get-fullname doc)))) ) (vla-saveas doc dwg) ) ) ) ) ) (princ (strcat "\n** Error in " (vl-filename-base dwg) ".dwg: " (vl-catch-all-error-message err))) ) (princ (strcat "\n** Unable to open: " (vl-filename-base dwg) ".dwg")) ) ) (if progress (progn (vl-catch-all-apply 'acet-ui-progress) (setq progress nil)) ) ;; Editing block definitions changes every insertion, so ;; the current drawing needs regenerating to show it. (if (and (= "1" TS:Cur) (= 1024 (logand 1024 TS:Bits))) (vla-regen acdoc acallviewports) ) (princ (strcat "\n" (itoa (length dwgs)) " drawing" (if (= 1 (length dwgs)) "" "s") " processed.")) ;; ---- the report --------------------------------------- (if (null *TextSweep:Report*) (princ "\nNothing matched - no replacements made.") (progn (princ (strcat "\n" (itoa (length *TextSweep:Report*)) (if (= "1" TS:Search) " match" " replacement") (if (= 1 (length *TextSweep:Report*)) "" "s") " found.")) ;; A search-only run always produces a report, ;; because the report IS the result. (if (or (= "1" TS:Search) (= 512 (logand 512 TS:Bits))) (progn (setq ftmp (strcat TS:Path "\\TextSweepReport" (menucmd "m=$(edtime,$(getvar,DATE),YYYYMODD)") ".csv")) (if (TextSweep:Report ftmp ;; Sorted by drawing, then by ;; object type within each -- two ;; passes, because vl-sort is ;; stable so the second sort keeps ;; the first one's order within ;; each group. (vl-sort (vl-sort *TextSweep:Report* '(lambda ( a b ) (< (cadddr a) (cadddr b)))) '(lambda ( a b ) (< (car a) (car b)))) ) (progn (princ (strcat "\nReport written to " ftmp)) (if (null (TextSweep:OpenFile ftmp)) (princ "\nThe report could not be opened automatically.") ) ) (princ "\nThe report file could not be written.") ) ) ) ) ) (TextSweep:WriteConfig cfg (mapcar 'eval syms)) (vla-endundomark acdoc) ) ) ) ) (TextSweep:Restore) (princ) ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:AddPair ;;; ;;; Adds the current find/replace boxes to the list and clears them. ;;; ;;; Defined at file scope rather than inside the command because the dialog ;;; callbacks reference it by name; it reads and writes the command's own ;;; variables through dynamic scope. ;;; --------------------------------------------------------------------------- (defun TextSweep:AddPair ( ) (cond ( (or (null findstr) (= "" findstr)) (alert "Please enter something to find.") ) ( t ;; An empty replacement is legitimate -- it deletes the search ;; text -- so nil is normalised to an empty string rather than ;; being rejected. (or repstr (setq repstr "")) (mapcar 'set_tile '("fstr" "rstr") '("" "")) (setq TS:Pairs (TextSweep:ShowPairs "rep_list" (TextSweep:SortByFirst (cons (cons findstr repstr) TS:Pairs))) findstr nil repstr nil ) ) ) (princ) ) ;;; =========================================================================== ;;; S U P P O R T F U N C T I O N S ;;; =========================================================================== ;;; --------------------------------------------------------------------------- ;;; TextSweep:DocPath ;;; ;;; Returns a document's full path. A drawing that has never been saved has ;;; an empty FullName, so the path and name are assembled instead. ;;; --------------------------------------------------------------------------- (defun TextSweep:DocPath ( doc ) (if (= "" (vla-get-fullname doc)) (strcat (vl-string-right-trim "\\" (vla-get-path doc)) "\\" (vla-get-name doc)) (vla-get-fullname doc) ) ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:DbxDocument ;;; ;;; Creates an ObjectDBX document object, or nil. The ProgID is ;;; version-stamped from AutoCAD 2004 (version 16) onward. ;;; --------------------------------------------------------------------------- (defun TextSweep:DbxDocument ( app / obj ver ) (setq ver (atoi (getvar 'acadver)) obj (vl-catch-all-apply 'vla-getinterfaceobject (list app (if (< ver 16) "ObjectDBX.AxDbDocument" (strcat "ObjectDBX.AxDbDocument." (itoa ver)) ) ) ) ) (if (vl-catch-all-error-p obj) (progn (princ "\nUnable to interface with ObjectDBX.") nil) obj ) ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:UnlockLayers / TextSweep:LockLayers ;;; ;;; Unlock every locked layer and return the list, so the exact original ;;; state can be restored. Layers already unlocked are never touched. ;;; --------------------------------------------------------------------------- (defun TextSweep:UnlockLayers ( doc / lst ) (vlax-for lay (vla-get-layers doc) (if (= :vlax-true (vla-get-lock lay)) (setq lst (cons lay lst)) ) ) (foreach lay lst (vla-put-lock lay :vlax-false)) lst ) (defun TextSweep:LockLayers ( lst ) (foreach lay lst (vl-catch-all-apply 'vla-put-lock (list lay :vlax-true)) ) (princ) ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:AllFiles ;;; ;;; Every file in a folder matching the filter, optionally including ;;; sub-folders at any depth. ;;; --------------------------------------------------------------------------- (defun TextSweep:AllFiles ( dir subs filter / TextSweep:SubFolders ) ;; "." and ".." are removed by name rather than by position: their place ;; in the listing is not guaranteed, and descending into ".." would ;; recurse upwards forever. (defun TextSweep:SubFolders ( folder / here ) (apply 'append (mapcar '(lambda ( f ) (setq here (strcat folder "\\" f)) (cons here (TextSweep:SubFolders here)) ) (vl-remove "." (vl-remove ".." (vl-directory-files folder nil -1))) ) ) ) (if (and dir (vl-file-directory-p (setq dir (TextSweep:FixDir dir)))) (apply 'append (mapcar '(lambda ( folder ) (mapcar '(lambda ( name ) (strcat folder "\\" name)) (vl-directory-files folder filter 1)) ) (cons dir (if subs (TextSweep:SubFolders dir))) ) ) ) ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:PickFolder ;;; ;;; The native Windows folder picker. Two COM objects are created and both ;;; must be released explicitly; the releases sit outside the catch so they ;;; happen even when the picker fails. ;;; --------------------------------------------------------------------------- (defun TextSweep:PickFolder ( msg dir flg / err fold path self shell ) (setq err (vl-catch-all-apply '(lambda ( / app hwnd ) (setq app (vlax-get-acad-object) shell (vla-getinterfaceobject app "Shell.Application") hwnd (vl-catch-all-apply 'vla-get-hwnd (list app)) fold (vlax-invoke-method shell 'browseforfolder (if (vl-catch-all-error-p hwnd) 0 hwnd) msg flg dir) ) (if fold (setq self (vlax-get-property fold 'self) path (TextSweep:FixDir (vlax-get-property self 'path)) ) ) ) ) ) (if self (vlax-release-object self)) (if fold (vlax-release-object fold)) (if shell (vlax-release-object shell)) (if (vl-catch-all-error-p err) nil path) ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:OpenFile ;;; ;;; Opens a file in whatever application Windows associates with it -- the ;;; report in Excel, typically. Returns T on success. ;;; --------------------------------------------------------------------------- (defun TextSweep:OpenFile ( file / res shell ) (setq res (vl-catch-all-apply '(lambda nil (setq shell (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application")) (vlax-invoke shell 'open file) ) ) ) (if shell (vlax-release-object shell)) (not (vl-catch-all-error-p res)) ) ;;; --------------------------------------------------------------------------- ;;; List and string helpers. ;;; --------------------------------------------------------------------------- ;; Sorts find-and-replace pairs by their search string. (defun TextSweep:SortByFirst ( lst ) (vl-sort lst '(lambda ( a b ) (< (car a) (car b)))) ) ;; Removes items by POSITION rather than by value, since two pairs can ;; legitimately share a search string. (defun TextSweep:RemoveNth ( idxs lst / n ) (setq n -1) (vl-remove-if '(lambda ( x ) (vl-position (setq n (1+ n)) idxs)) lst) ) ;; Replaces the item at position n. (defun TextSweep:SubstNth ( lst item n ) (if lst (if (zerop n) (cons item (cdr lst)) (cons (car lst) (TextSweep:SubstNth (cdr lst) item (1- n))) ) ) ) ;; Joins a list of strings with a separator between each pair. (defun TextSweep:Join ( lst del / out ) (setq out (car lst)) (foreach x (cdr lst) (setq out (strcat out del x))) out ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:WriteConfig / TextSweep:ReadConfig ;;; ;;; Save and reload the settings, one value per line. Values are written in ;;; printed form and read back with read, which round-trips strings, numbers ;;; and whole lists faithfully -- the find-and-replace list included. ;;; ;;; The read is forgiving: a short or hand-edited file leaves the remaining ;;; settings at their defaults rather than raising an error. ;;; --------------------------------------------------------------------------- (defun TextSweep:WriteConfig ( cfg lst / des ) (if (setq des (open cfg "w")) (progn (foreach x lst (write-line (vl-prin1-to-string x) des)) (close des) t ) ) ) (defun TextSweep:ReadConfig ( cfg syms / des line ) (if (and (setq cfg (findfile cfg)) (setq des (open cfg "r")) ) (progn (foreach sym syms (if (setq line (read-line des)) ( (lambda ( val ) (if (not (vl-catch-all-error-p val)) (set sym val)) ) (vl-catch-all-apply 'read (list line)) ) ) ) (close des) t ) ) ) ;;; --------------------------------------------------------------------------- ;;; TextSweep:WriteSearches / TextSweep:ReadSearches ;;; ;;; Save and reload the named searches. ;;; ;;; The file format is deliberately plain text, so it can be read and edited ;;; by hand and shared between users: ;;; ;;; [name of saved search] ;;; find stringreplace string ;;; find stringreplace string ;;; (blank line) ;;; ;;; A line in square brackets with no tab starts a new group; a line ;;; containing a tab is an entry within it. ;;; --------------------------------------------------------------------------- (defun TextSweep:WriteSearches ( file lst / des ) (if (setq des (open file "w")) (progn (foreach ref lst (write-line (strcat "[" (car ref) "]") des) (foreach pair (cdr ref) (write-line (strcat (car pair) "\t" (cdr pair)) des) ) (write-line "" des) ) (close des) t ) ) ) (defun TextSweep:ReadSearches ( file / des group line out pos ) (if (and (setq file (findfile file)) (setq des (open file "r")) ) (progn (while (setq line (read-line des)) (cond ;; A group heading. ( (and (wcmatch line "`[*`]") (not (wcmatch line "*\t*"))) (if group (setq out (cons (reverse group) out))) (setq group (list (substr line 2 (- (strlen line) 2)))) ) ;; An entry within the current group. ( (wcmatch line "*\t*") (setq pos (vl-string-position 9 line) group (cons (cons (substr line 1 pos) (substr line (+ pos 2))) group) ) ) ) ) (close des) ;; The last group has no heading after it to trigger the flush. (if group (setq out (cons (reverse group) out))) (reverse out) ) ) ) (princ "\nTextSweep loaded. Type TEXTSWEEP for batch find and replace across drawings.") (princ) ;;; --------------------------------------------------------------------------- ;;; End of file ;;; ---------------------------------------------------------------------------