Jump to content

Batch Find and Replace

afritz0108

By afritz0108
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

afritz0108 Newbie

afritz0108

Posted
Posted

Hello all,

im looking for a script or lisp that can change text inside a block on multiple drawings. 
I have no experience with Autocad Lisp.

I’ve attached the block. Is there a way to change the text to whatever I need?

Block.dwg

afritz0108 Newbie

afritz0108

Posted
  • Author
Posted

Steven 

What would I need to change on the code for it to work? Also how does it work on multiple drawings?

Currently it says error too few arguments

Steven P Grand Master

Steven P

Posted
Posted (edited)

You'll need to send the correct inputs to this LISP to make it work, something like this:

  

(defun c:txtFindReplace( / 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: "))
  (c:FindReplaceAll old_text new_text)
  (princ)
)

 

All you really need is this line:

  

(c:FindReplaceAll old_text new_text)

 

I think this works with Lees ScriptWriter and also Scriptwriterpro:

 

 

EDIT: This the line should be this:

_.Open *file* (c:FindReplaceAll "Old Text" "New Text") _.Saveas *file* _.Close

 

(I have a different batch interface but never finished it well enough to publish so am only guessing the above)

 

something like that

Edited by Steven P
afritz0108 Newbie

afritz0108

Posted
  • Author
Posted

Would I replace old_text & new_text 

with what I want to change?

Steven P Grand Master

Steven P

Posted
Posted

Yes, so try this to see it work, open a drawing or start a new drawing and insert some text, go old school and "Hello world", load up the LISP from my AutoDesk link an also the c:textfindreplace LISP

 

Now try this and noting the " " either side of the 2 text strings

  

(c:FindReplaceAll "Hello World" "Goodbye World")

 

This should change the text. You do the same, insert or create a block and again insert a text into the block and also an attribute. Put text to be maybe "Hello World", and change the attribute to be "Goodbye World".. you should have a block and a text, then run the line again, perhaps this time: 

  

(c:FindReplaceAll "Goodbye World" "Hello World")

 

and with luck all 3 texts will all say Hello World. Try again without the capitals and and since the LISP is case sensitive nothing will change.

BIGAL Grand Master

BIGAL

Posted
Posted

Try this subtle change saves typing one find variable. You can copy parts of the text from command line and use in new text the T supports spaces in new string.

  

; Findreplaceall By Terry Cad 2006

(defun c:txtFindReplace( / strold strnew)
(if (not Findreplaceall)(load "findreplaceall.lsp"))
  (while (setq ent (car (nentsel "\nPick source text Enter to exit ")))
    (setq obj (vlax-ename->vla-object ent))
    (setq strold (vlax-get obj 'textstring))
    (setq strnew (getstring (strcat "\nReplace " strold " with ? ") T))
    (c:FindReplaceAll strold strnew)
  )
(princ)
)
(c:txtFindReplace)

 

findreplaceall.lsp

  • Like 1
devitg Experienced

devitg

Posted
Posted
On 10/20/2024 at 1:22 PM, afritz0108 said:

Hello all,

im looking for a script or lisp that can change text inside a block on multiple drawings. 
I have no experience with Autocad Lisp.

I’ve attached the block. Is there a way to change the text to whatever I need?

Block.dwg 77.75 kB · 2 downloads

 

@afritz0108 As I understand, you mean to change the same text that is at the same  blockreference in a lot of DWGs. 

If so, you have to use Leemark ODBX exchanger  

It seems to  be it is some block in a Title  or whatever other dwg part

 

Please upload at least 3 o 4 of such dwg where the text XXXXXXXX has to  be change at such dwg's 

 

 

 

rlx Veteran

rlx

Posted
Posted

Not so long ago I made this but haven't had time to really test it. I don't think blockname filter is active yet. But you're welcome to try it on your own risk.

It uses odbx , you can input multiple old / new texts separated by separator (;)

Think apart from blockname filter most options work , just test it on a test folder first.

 

image.png.3ce3768157ea5a2dc95b66685d9b9eb1.png

 

🐉

  

;;; Dbx Change Block Text
(defun c:DbxChgTxt
       ( /
        ;;; global variables
        OldErr prog-base actApp actDoc actDocs allopen regkey regvar sysvar-names sysvar-old-values
        
        ;;; runtime variables
        drawing-folder drawing-list cur-count max-count start
        old-str-list new-str-lst
        
        ;;; ini variables
        DbxChgTxt-Drawing-Folder DbxChgTxt-Include-Subfolders DbxChgTxt-Block-Names
        DbxChgTxt-Old-Text DbxChgTxt-New-Text DbxChgTxt-Case-Sensitive
        DbxChgTxt-Include-Text DbxChgTxt-Include-Attributes DbxChgTxt-Include-Block-Text DbxChgTxt-Separator
        
       )
  (DbxChgTxt_Init)
  (DbxChgTxt_Start_Main_Dialog)
  (DbxChgTxt_Exit)
  (_ReleaseAll)
  (princ "\nDone.")
  (princ)
)

(defun DbxChgTxt_Doit ( / save)
  (cond
    ;;; handled by dialog
    ((not
       (or
         (and (not (void DbxChgTxt-Drawing-Folder)) (vl-file-directory-p DbxChgTxt-Drawing-Folder)
              (setq drawing-folder DbxChgTxt-Drawing-Folder))
         (and (setq drawing-folder (GetShellFolder "Select folder with drawings"))
              (vl-file-directory-p drawing-folder))
       )
     )
     (princ "\nDrawing folder selection aborted"))
    ((not (vl-consp (setq drawing-list (alldrawings drawing-folder))))
     (princ "\nNo dwg files found in selected folder"))
    ((not (_InitObjectDBX)) (alert "Unable to start ObjectDbx"))
    (t
      (setq cur-count 0 max-count (length drawing-list) start (car (_vl-times)))
      (_StartProgressDialog (strcat "Processing " (itoa max-count) " drawings...")
        '(progn
          (foreach dwg drawing-list
           (if (setq doc (odbx_open dwg))
            (progn
              (ChgTxtDbxDoc doc DbxChgTxt-Old-Text DbxChgTxt-New-Text DbxChgTxt-Case-Sensitive DbxChgTxt-Include-Block-Text)
              (if (vl-catch-all-error-p (setq save (vl-catch-all-apply 'vla-saveas (list doc dwg))))
                (princ (strcat  "Save error: " (vl-catch-all-error-message save) "\ndrawing : " (vl-princ-to-string dwg))))
            )
            (princ (strcat "\nUnable to open : " dwg))
           )
           ;;; update progress
           (setq cur-count (1+ cur-count)) (_UpdateProgressDialog)
         )
         (done_dialog)
        )
      )
     )
  )
)


;;; --- Registry Settings ------------------------------- Begin Registry Settings ------------------------------- Registry Settings --- ;;;

(defun InitDefaultRegistrySettings ()
  (setq regkey "HKEY_CURRENT_USER\\SOFTWARE\\DbxChgTxt\\")
  ;;; regkeys must be strings ("variable name" "default value")
  (setq regvar
     (list
       '("DbxChgTxt-Drawing-Folder" "")					;;; xxxxxx
       '("DbxChgTxt-Include-Subfolders" "1")				;;; xxxxxx
       '("DbxChgTxt-Block-Names" "")					;;; xxxxxx
       '("DbxChgTxt-Old-Text" "")					;;; xxxxxx
       '("DbxChgTxt-New-Text" "")					;;; xxxxxx
       '("DbxChgTxt-Case-Sensitive" "0")				;;; xxxxxx

       '("DbxChgTxt-Include-Text" "0")					;;; xxxxxx
       '("DbxChgTxt-Include-Attributes" "0")				;;; xxxxxx
       '("DbxChgTxt-Include-Block-Text" "0")				;;; xxxxxx
       '("DbxChgTxt-Separator" ";")					;;; xxxxxx
       
       
    )
  )
  (mapcar '(lambda (x)(set (read (car x)) (cadr x))) regVar)
)

(defun ReadSettingsFromRegistry ()
  (mapcar '(lambda (x / n v)
    (if (setq v (vl-registry-read regkey (setq n (car x)))) (set (read n) v) (vl-registry-write regkey n (cadr x)))) regvar))

(defun WriteSettingsToRegistry ()
  (mapcar '(lambda (x) (vl-registry-write regkey (car x) (eval (read (car x))))) regvar))

;;; --- Registry Settings -------------------------------- End Registry Settings -------------------------------- Registry Settings --- ;;;




(defun DbxChgTxt_Init ()
  (vl-load-com)
  ; initialize error handling
  (setq OldErr *error* *error* DbxChgTxt_Err)
  ; initialize LC prog-base & data folder
  (if (not (vl-file-directory-p (setq prog-base (strcat (getvar 'MYDOCUMENTSPREFIX) "\\lisp\\DbxChgTxt\\")))) (rlx_mf prog-base))
  ;;; clean after crash
  (_ReleaseAll)
  ; get a list of all op drawings in current session , named drawings only
  (setq actApp (vlax-get-acad-object) actDoc (vla-get-ActiveDocument actApp) actDocs (vla-get-documents actApp))
  ;;; no nameless drawings
  (vlax-for doc actDocs
    (if (= 1 (vlax-variant-value (vla-getvariable doc "DWGTITLED")))
      (setq allopen (cons (cons (strcase (vla-get-fullname doc)) doc) allopen))))
  ;;; backup & set system variables
  (setq sysvar-names (list (cons 'backgroundplot 0))
        sysvar-old-values (mapcar '(lambda (x)(getvar (car x))) sysvar-names))
  (mapcar '(lambda (x)(setvar (car x) (cdr x))) sysvar-names)
  ;;; init registry variables
  (InitDefaultRegistrySettings)(ReadSettingsFromRegistry)
)


(defun DbxChgTxt_Err ($s) (princ $s)(DbxChgTxt_Exit)(setq *error* OldErr)(princ))

(defun DbxChgTxt_Exit ()
  ; cleanup dialogs
  (mapcar '(lambda (x) (if (not (null x)) (unload_dialog x)))
	   (list LC-Main-Dialog-dcl progress-dcl-id))
  
  (mapcar '(lambda (x) (if (not (null x)) (close x)))
	   (list LC-Main-Dialog-fp progress-dcl-fp))
  
  (mapcar '(lambda (x) (if (and (not (null x)) (findfile x)) (vl-file-delete x)))
	   (list LC-Main-Dialog-fn progress-dcl-fn))
                 
  ; reset system variables
  (mapcar '(lambda (x y)(setvar (car x) y)) sysvar-names sysvar-old-values)
  (_ReleaseAll) (term_dialog) (gc) (princ "\nDone") (terpri) (princ)
)


;;; --- Odbx ---------------------------------------------- Begin Odbx Section ----------------------------------------------- Odbx --- ;;;

(defun GetAllOpenDocs ()
  (or actApp (setq actApp (vlax-get-acad-object))) (or actDoc (setq actDoc (vla-get-ActiveDocument actApp)))
    (or actDocs (setq actDocs (vla-get-documents actApp)))
  (vlax-for doc actDocs (if (= 1 (vlax-variant-value (vla-getvariable doc "DWGTITLED"))); no nameless drawings
    (setq AllOpen (cons (cons (strcase (vla-get-fullname doc)) doc) AllOpen))))
)
       
(defun _ReleaseAll ()
  (mapcar '(lambda(x) (if (and (= 'vla-object (type x)) (not (vlax-object-released-p x)))
    (vlax-release-object x))(set (quote x) nil)) (list actLay actDoc actDocs actApp actDbx))(gc))

(defun _InitObjectDBX ()(or actApp (setq actApp (vlax-get-acad-object)))
  (or actDoc (setq actDoc (vla-get-ActiveDocument actApp)))(or AllOpen (setq AllOpen (GetAllOpenDocs)))
  (setq actDbx (vl-catch-all-apply 'vla-getinterfaceobject (list actApp (dbx_ver))))
  (if (or (null actDbx)(vl-catch-all-error-p actDbx))(progn (princ "\nObjectDbx not available")(setq actDbx nil)))
  actDbx
)


(defun odbx_open ( $dwg / _pimp doc) (or AllOpen (GetAllOpenDocs))
  (defun _pimp (s) (strcase (vl-string-trim " ;\\" (vl-string-translate "/" "\\" s))))
  (cond ((or (void $dwg) (not (findfile $dwg)))(princ "\nInvalid drawing")(setq doc nil))
	((not (or actDbx (_InitObjectDBX)))(princ "\nObjectDbx not available")(setq doc nil))
        ((setq doc (cdr (assoc (_pimp $dwg) AllOpen))))
	((vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list actDbx (findfile $dwg))))
	 (princ "\nUnable to open drawing.")(setq doc nil))
	(t (setq doc actDbx)))
  doc
)

(defun odbx_close ( %doc ) (if (and (= 'vla-object (type %doc))
  (not (vlax-object-released-p %doc)))(progn (vlax-release-object %doc))(setq %doc nil)))

(defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v)))))

;;; --- Odbx ---------------------------------------------- End Odbx Section ------------------------------------------------- Odbx --- ;;;


;;; --- Progress Bar ------------------------------------ Begin of Progress Bar -------------------------------------- Progress Bar --- ;;;

(defun _StartProgressDialog ( msg fx / drv rtn)
  (_WriteProgressDialog msg)
  (if (and (setq progress-dcl-id (load_dialog progress-dcl-fn)) (new_dialog "progress" progress-dcl-id))
    (progn (_InitProgressDialog) (action_tile "bt_start" "(mode_tile \"bt_cancel\" 1)(mode_tile \"bt_start\" 1)(setq rtn T)(eval fx)")
      (action_tile "bt_cancel" "(setq rtn nil)(term_dialog)")(start_dialog))) rtn)

(defun _WriteProgressDialog-org ( $msg )
  (if (and (setq progress-dcl-fn (vl-filename-mktemp ".dcl")) (setq progress-dcl-fp (open progress-dcl-fn "w"))) (write-line
    (strcat "progress:dialog{label=\"" $msg "\";:boxed_column{:text_part{key=\"tp_info\";}spacer;"
      ":image{key=\"im_progressbar\";height=1;}}spacer;:row {children_alignment=centered;children_fixed_width=true;"
	":column{width=16;}:button{key=\"bt_start\";label=\" Start \";}:button{key=\"bt_cancel\";label=\"Cancel\";"
           "is_cancel=true;}:column{width=16;}}}") progress-dcl-fp))(if progress-dcl-fp (close progress-dcl-fp))(gc))

(defun _WriteProgressDialog ( $msg )
  (if (and (setq progress-dcl-fn (vl-filename-mktemp ".dcl")) (setq progress-dcl-fp (open progress-dcl-fn "w"))) (write-line
    (strcat "progress:dialog{label=\"" $msg "\";"
            ":boxed_column {:text_part{key=\"tp_info\";}spacer;:image {key=\"im_progressbar\";height=1;}}"
            ;;; "spacer;:image {height=1;color=dialog_background;key=\"im_sub_progressbar\";}"
            "spacer;:text_part {key=\"tp_sub_progress\";}"
            "spacer;:row {children_alignment=centered;children_fixed_width=true;"
            ":column{width=16;}:button{key=\"bt_start\";label=\" Start \";}:button{key=\"bt_cancel\";label=\"Cancel\";"
           "is_cancel=true;}:column{width=16;}}}") progress-dcl-fp))(if progress-dcl-fp (close progress-dcl-fp))(gc))

(defun _InitProgressDialog ()
  (setq imx (dimx_tile "im_progressbar") imy (dimy_tile "im_progressbar"))
  (start_image "im_progressbar")(fill_image 0 0 imx imy -15)(end_image)
  (set_tile "tp_info" (strcat " Items to process : " (if max-count (itoa max-count) "0"))))

(defun _UpdateProgressDialog ()
  (or imx (setq imx (dimx_tile "im_progressbar")))(or imy (setq imy (dimy_tile "im_progressbar")))
  (start_image "im_progressbar")(fill_image 0 0 (/ (* cur-count imx) max-count) imy 3)(end_image)
  (set_tile "tp_info" (strcat " Processing " (itoa cur-count) " of " (itoa max-count))))

(defun ThisProgressBarWillSelfDestruct_In (i / imax)
  (repeat (setq imax i)
    ; clear progress bar image (imx & imy are set in _InitProgressDialog)
    (start_image "im_progressbar")(fill_image 0 0 imx imy -15)(end_image)
    (start_image "im_progressbar")(fill_image 0 0 (/ (* i imx) imax ) imy 1)(end_image)
    (set_tile "tp_info" (strcat "This dialog will selfdestruct in : " (itoa i)))
    (setq i (1- i)) (wait 1)
  )
  (term_dialog)
)

(defun wait (sec / stop)(setq stop (+ (getvar "DATE") (/ sec 86400.0)))(while (> stop (getvar "DATE"))))

;;; --- Progress Bar ------------------------------------- End of Progress Bar --------------------------------------- Progress Bar --- ;;;



;;;-----------------------------------------------------------------|-------------------------------------------------------------------;;;



;;; --- Tiny Lisp ---------------------------------------- Begin of Tiny Lisp ------------------------------------------- Tiny Lisp --- ;;;

(defun uc (s) (alert (strcat "under construction : " s)))

; print list (test function)
(defun prl (lst)(mapcar '(lambda(x)(princ "\n")(princ x)) lst))

; test : (commatize '("a" "b" "c"))
(defun commatize (l) (apply 'strcat (cdr (apply 'append (mapcar (function (lambda (x) (list "," x))) l)))))

; (de-commatize "a,b,c")  ->   ("a" "b" "c")
(defun de-commatize (s / p)
  (if (setq p (vl-string-search "," s))(cons (substr s 1 p)(de-commatize (substr s (+ p 2))))(list s)))

; (SplitStr "a,b" ",") -> ("a" "b")
(defun SplitStr (s d / p)
  (if (setq p (vl-string-search d s))(cons (substr s 1 p)(SplitStr (substr s (+ p 1 (strlen d))) d))(list s)))


(defun void (x)
  (or (eq x nil) (and (listp x)(not (vl-consp x))) (and (eq 'STR (type x)) (eq "" (vl-string-trim " \t\r\n" x)))))

(defun string-p (s) (if (= (type s) 'str) t nil))

; independent simple dialog for getstring so no switching needed from dialog to command line (_ask "How are you?")
(defun _ask ( $m / f p d r s) (if (and (setq f (vl-filename-mktemp ".dcl"))(setq p (open f "w")))
  (progn (write-line (strcat "ask :dialog {label =\"" $m "\";:edit_box {key=\"eb\";}spacer;ok_cancel;}") p)(close p)(gc)
    (setq d (load_dialog f))(new_dialog "ask" d) (mapcar '(lambda(x y)(action_tile x y)) '("eb" "accept" "cancel")
      '("(setq s $value)""(done_dialog 1)""(done_dialog 0)"))(setq r (start_dialog))(unload_dialog d)(vl-file-delete f)))
  (if (and (= r 1) (= 'STR (type s)) (/= s "")) s nil)
)

;;; generic getfolder routine with possibility to create a new subfolder (GetShellFolder "select path")
(defun GetShellFolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application"))
  (setq f (vlax-invoke s 'browseforfolder 0 m 65536 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path))
     (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s))
  (if f (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" f)) "\\")))

;;; (getsubfolders "c:/temp/lisp")
(defun getsubfolders ( d / l r s )(setq d (Dos_Path d))(setq l (list (vl-string-trim "/\\" d)))(while l (setq s nil)
  (foreach d l (setq s (append s (mapcar (function (lambda (x)(strcat d "\\" x))) (vl-remove-if (function
    (lambda (x)(member x '("." ".."))))(vl-directory-files d nil -1)))))) (setq r (append s r) l s))
  (cons d (mapcar 'Dos_Path r))
)


;;; rlx_mf - make folder , return T of nil
(defun rlx_mf ( fol / sf) (defun MF (rt sf) (if sf ((lambda (fol)(vl-mkdir fol)(MF fol (cdr sf)))(strcat rt "\\" (car sf)))))
  (if (setq sf (rlx_sf (vl-string-translate "/" "\\" fol))) (MF (car sf) (cdr sf))) (vl-file-directory-p fol))

(defun Dos_Path ($p) (if (= (type $p) 'STR)
  (strcase (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" $p)) "\\")) ""))

(defun alldrawings ( d / s l r) (setq l (mapcar 'Dos_Path (getsubfolders d)))
  (foreach s l (setq r (append r (mapcar '(lambda (x)(strcat s x))(vl-directory-files s "*.dwg" 1))))) r)

;;; get block name (block object)
(defun block-n (o) (if (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference"))
  (if (vlax-property-available-p o 'EffectiveName)(vla-Get-EffectiveName o)(vla-Get-Name o)) nil))

; test : (setq lst (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object))))
; returns sorted list (uppercase) like : ("BLOCK_A" "BLOCK_B" ...)
(defun GetDocBlockNames (d / o n l)(vlax-for o (vla-get-blocks d)(if (and (= :vlax-false (vla-get-isxref o))
  (= :vlax-false (vla-get-islayout o))(snvalid (setq n (vla-get-name o)) 0))(setq l (cons (strcase n) l))))
    (if (vl-consp l)(acad_strlsort l)))


; choose from list (cfl '("1""2""3"))
(defun cfl (l / f p d r) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w"))
 (princ "cfl:dialog{label=\"Choose\";:list_box{key=\"lb\";width=40;}ok_cancel;}" p)
  (not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)
   (progn (start_list "lb")(mapcar 'add_list l)(end_list)(action_tile "lb" "(setq r (nth (atoi $value) l))(done_dialog 1)")
    (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")(action_tile "cancel" "(setq r nil)(done_dialog 0)")
     (start_dialog)(unload_dialog d)(vl-file-delete f))) (cond ((= r "") nil)(r r)(t nil)))

;;; multiple from list (setq inp (mfl '("bak" "dwg" "pdf" "tif") '("dwg")))
;;; added all / none buttons
(defun mfl (%l %df / toggle set_all l f p d r)
  (setq l (mapcar '(lambda (x)(if (member x %df)(strcat "[X] " x)(strcat "[O] " x))) %l))
  (defun toggle (v / s r)(if (eq (substr (setq r (nth (atoi v) l)) 2 1) "X")(setq s "[O] ")(setq s "[X] "))
    (setq l (subst (strcat s (substr r 5)) r l))(start_list "lb")(mapcar 'add_list l)(end_list))
  (defun set_all (i)(setq l (mapcar '(lambda (x)(if (eq i "1") (strcat "[X] " x) (strcat "[O] " x))) %l))
    (start_list "lb")(mapcar 'add_list l)(end_list))
  (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w"))
       (princ (strcat "cfl:dialog{label=\"Choose\";:list_box {height=12;key=\"lb\";}"
         ":button{label=\"All\";key=\"bt_all\";}:button{label=\"None\";key=\"bt_none\";}ok_cancel;}") p)
       (not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)
       (progn (start_list "lb")(mapcar 'add_list l)(end_list) (action_tile "lb" "(toggle $value)")
         (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")
         (action_tile "cancel" "(setq r nil)(done_dialog 0)")
         (action_tile "bt_all" "(set_all \"1\")")(action_tile "bt_none" "(set_all \"0\")")
         (start_dialog)(unload_dialog d)(vl-file-delete f)))
  (mapcar '(lambda (y)(substr y 5)) (vl-remove-if '(lambda (x)(eq (substr x 2 1) "O")) l))
)

;;; display list (plus message)
(defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l))))
  (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";"
   "height=16;width="(itoa w)";} ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)
    (progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")
      (start_dialog)(unload_dialog d)(vl-file-delete f))))

;;; multiply my dwg
(defun c:mummy ( / o d i )
  (setq o (getvar "expert"))(setvar "expert" 5)
  (setq d (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname"))) i 1)
  (repeat 10 (command "_saveas" "" (strcat d "-" (itoa i))) (setq i (1+ i)))
  (command "_saveas" "" d)
  (setvar "expert" o)
  (princ)
)

;;; doc = dbxdoc , os = old string , ns = new string , cs = case , bt = block text
(defun ChgTxtDbxDoc ( doc os ns cs bt / os-list ns-list case txt att btext dl save )
  (cond
    ((void doc)(princ "Invalid dbx document"))
    ((void os )(princ "Invalid old string"))
    (t
     ;;; setup some defaults as safeguard
     (if (void DbxChgTxt-Separator)(setq DbxChgTxt-Separator ";"))
     (setq os-list (SplitStr os DbxChgTxt-Separator))
     (if (void ns)
       ;;; if new string is empty make ns-list with as many "" as os-list is long
       (setq ns-list (repeat (length os-list)(setq ns-list (cons "" ns-list))))
       (setq ns-list (SplitStr ns DbxChgTxt-Separator))
     )
     ;;; DbxChgTxt-Include-Text DbxChgTxt-Include-Attributes DbxChgTxt-Include-Block-Text
     (if (eq DbxChgTxt-Case-Sensitive "1") (setq case t) (setq case nil))
     (if (eq DbxChgTxt-Include-Text "1") (setq txt t) (setq txt nil))
     (if (eq DbxChgTxt-Include-Attributes "1") (setq att t) (setq att nil))
     (if (eq DbxChgTxt-Include-Block-Text "1") (setq btext t) (setq btext nil))
     (setq dl (mapcar 'list os-list ns-list))
     (dbx_ct doc case txt att btext dl)
     (if (vl-catch-all-error-p (setq save (vl-catch-all-apply 'vla-saveas (list doc dwg))))
       (princ (strcat  "Save error: " (vl-catch-all-error-message save) "\ndrawing : " (vl-princ-to-string dwg))))
    )
  )
)

(defun dbx_ct ( doc case txt att btext dl / _upd regex app dbxdoc)
  
  ; update object , %o = object , %l = old/new list like '(("old1" "new1")("old2" "new2")...)
  (defun _upd (%o %l) (mapcar '(lambda (p)(vlax-put-property regex 'pattern (car p))
    (vla-put-textstring %o (vlax-invoke regex 'replace (vla-get-textstring %o) (cadr p)))) %l))
  
  ;;; for testing
  ;;; (setq dl '(("A" "@") ("0" "#")))
  ;;; (setq #RlxBatch-TextUtil-Include-BlockText "1")
  ;;; (setq #RlxBatch-TextUtil-Match-String-Case "1")
  (setq dbxdoc doc)

  ;;; init regex (should be done only once at init dbx
  (or regex (setq regex (vlax-get-or-create-object "VBScript.RegExp")))
  (vlax-put-property regex 'global actrue)
  (vlax-put-property regex 'multiline actrue)
  (if (boundp case)
    (vlax-put-property regex 'ignorecase acfalse) (vlax-put-property regex 'ignorecase actrue))
  
  ;;; (vlax-put-property regex 'pattern "NOT FOR CONSTRUCTION") -> replace with data list 
  
  ;;; first process all block definitions (for now just work with active doc)
  (if (boundp btext) (vlax-for b (vla-get-blocks dbxdoc)
    (vlax-for o b (if (member (vla-get-objectname o) '("AcDbMText" "AcDbText")) (_upd o dl)))))
  
  ;;; now process the rest
  (vlax-for l (vla-get-layouts dbxdoc) (vlax-for o (vla-get-block l) (setq obn (vla-get-objectname o))
    (cond ((member obn '("AcDbText" "AcDbMText" "AcDbAttributeDefinition")) (_upd o dl))
      ((and (= obn "AcDbBlockReference") (eq :vlax-true (vla-get-HasAttributes o)))
        (mapcar '(lambda (a)(_upd a dl)) (vlax-invoke o 'GetAttributes))))))
  
  (vl-catch-all-apply 'vla-Regen (list dbxdoc acAllViewports))
  (vl-catch-all-apply 'vla-zoomextents (list (vlax-get-acad-object)))
  (princ)
)


;;; --- Tiny Lisp ----------------------------------------- End of Tiny Lisp -------------------------------------------- Tiny Lisp --- ;;;



;;; --- dialog section ----------------------------------- begin dialog section ------------------------------------ dialog section --- ;;;

; SaveDialogData evaluates all vars from %tl and returns them as a list, reset does the opposite
(defun Save_Dialog_Data (%tl) (mapcar '(lambda (x) (eval (car x))) %tl))
(defun Cancel_Dialog (%tl %rd) (mapcar '(lambda (x y) (set (car x) y)) %tl %rd))
(defun Set_Dialog_Tiles (%tl) (mapcar '(lambda (x / v) (if (eq 'str (type (setq v (eval (car x))))) (set_tile (cadr x) v))) %tl))

(defun DbxChgTxt_Create_Main_Dialog ()
  (if (and (setq DbxChgTxt-Main-Dialog-fn (strcat prog-base "DbxChgTxt.dcl"))
           (setq DbxChgTxt-Main-Dialog-fp (open DbxChgTxt-Main-Dialog-fn "w")))
    (mapcar
      '(lambda (x)(write-line x DbxChgTxt-Main-Dialog-fp)) ;;;(startapp "notepad" (findfile "acad.dcl"))
       (list
           "DbxChgTxt : dialog {label=\"DbxChgTxt - (Rlx Oct'24)\";spacer;"
           ":boxed_column {label=\"Drawing folder\";"
           "  :edit_box {edit_width=80;key=\"eb_drawing_folder\";}"
           "  :concatenation {alignment=centered;"
           "    :bt_24 {key=\"bt_select_drawing_folder\";label=\"Select folder\";}"
           "    :column {width=2;} :toggle {key=\"tg_include_subfolders\";label=\"Include subfolders\";}}"
           "}"

           ":boxed_column {label=\"Block name(s)\";"
           "  :edit_box {edit_width=80;key=\"eb_block_names\";}"
           "  :concatenation {alignment=centered;"
           "    :bt_24 {key=\"bt_block_from_current_drawing\";label=\"Current drawing\";}"
           "    :column {width=2;}:bt_24 {key=\"bt_block_from_external_drawing\";label=\"External drawing\";}}"
           "}"

           ":boxed_column {label=\"Old / new text\";"
           " :row {"
           "  :column {"
           "    :text {label=\"Old text\";}"
           "    :text {label=\"New text\";}"
           "  }"
           "  :column {"
           "    :edit_box {edit_width=64;key=\"eb_old_text\";}"
           "    :edit_box {edit_width=64;key=\"eb_new_text\";}"
           "  }"
           " }"
           " :concatenation {alignment=right;"
           "   :edit_box {edit_width=1;key=\"eb_separator\";label=\"Separator\";}"
           " }"
           "}"
           
           ":boxed_row {label=\"Options\";alignment=centered;"
           "  spacer;spacer;"
           "  :toggle {key=\"tg_include_text\";label=\"Text\";}"
           "  :toggle {key=\"tg_include_attributes\";label=\"Attributes\";}"
           "  :toggle {key=\"tg_include_block_text\";label=\"Block text\";}"
           "  :toggle {key=\"tg_case_sensitive\";label=\"Case sensittive\";}"
           "}"
           
           "spacer;spacer;ok_cancel;"

           "}"
           "bt_24 :button {width=24;fixed_width=true;}"
         );;; end list
    );;; end mapcar
  );;; end if
  ;;; (startapp "notepad" DbxChgTxtMain-Dialog-fn) ;;; test only
  (if DbxChgTxt-Main-Dialog-fp (close DbxChgTxt-Main-Dialog-fp))(gc)
)

(defun DbxChgTxt_Start_Main_Dialog ( / drv )
  ;;; main used for testing to force re-creation of dialog so latest changes are allways shown
  (setq DbxChgTxt-Main-Dialog-fn nil)
  (if (null DbxChgTxt-Main-Dialog-fn)(DbxChgTxt_Create_Main_Dialog))
  (if (and (setq DbxChgTxt-Main-Dialog-id (load_dialog DbxChgTxt-Main-Dialog-fn))
           (new_dialog "DbxChgTxt" DbxChgTxt-Main-Dialog-id))
    (progn
      (DbxChgTxt_Main_Dialog_Init)
      (DbxChgTxt_Main_Dialog_Update)
      (DbxChgTxt_Main_Dialog_Action)
      (setq drv (start_dialog))
      (cond
	((= drv  0)
         (Cancel_Dialog DbxChgTxt-Main-Dialog-tl DbxChgTxt-Main-Dialog-rd)
         (WriteSettingsToRegistry))
	((= drv  1)
         (WriteSettingsToRegistry)
         (DbxChgTxt_DoIt))
      )
    )
  )
  (if (and DbxChgTxt-Main-Dialog-fn (findfile DbxChgTxt-Main-Dialog-fn))
    (vl-file-delete (findfile DbxChgTxt-Main-Dialog-fn)))
  (setq DbxChgTxt-Main-Dialog-fn nil)
)

;;; variables DbxChgTxt-Drawing-Folder DbxChgTxt-Include-Subfolders DbxChgTxt-Block-Name DbxChgTxt-Old-Text
;;; DbxChgTxt-New-Text DbxChgTxt-Include-Text DbxChgTxt-Include-Attributes DbxChgTxt-Include-Block-Text DbxChgTxt-Separator
(defun DbxChgTxt_Main_Dialog_Init ( / p)
  ;;; edit boxes
  (set_tile "eb_drawing_folder" (if (not (void DbxChgTxt-Drawing-Folder)) DbxChgTxt-Drawing-Folder ""))
  (set_tile "eb_block_names" (if (not (void DbxChgTxt-Block-Names)) DbxChgTxt-Block-Names ""))
  (set_tile "eb_old_text" (if (not (void DbxChgTxt-Old-Text)) DbxChgTxt-Old-Text ""))
  (set_tile "eb_new_text" (if (not (void DbxChgTxt-New-Text)) DbxChgTxt-New-Text ""))
  (set_tile "eb_separator" (if (not (void DbxChgTxt-Separator)) DbxChgTxt-Separator ""))
  
  ;;; toggles
  (set_tile "tg_include_subfolders" (if (not (void DbxChgTxt-Include-Subfolders)) DbxChgTxt-Include-Subfolders "0"))
  (set_tile "tg_include_text" (if (not (void DbxChgTxt-Include-Text)) DbxChgTxt-Include-Text "0"))
  (set_tile "tg_include_attributes" (if (not (void DbxChgTxt-Include-Attributes)) DbxChgTxt-Include-Attributes "0"))
  (set_tile "tg_include_block_text" (if (not (void DbxChgTxt-Include-Block-Text)) DbxChgTxt-Include-Block-Text "0"))
  (set_tile "tg_case_sensitive" (if (not (void DbxChgTxt-Case-Sensitive)) DbxChgTxt-Case-Sensitive "0"))
)

(defun DbxChgTxt_Main_Dialog_Update ()
  ;;; edit boxes & toggles
  (setq DbxChgTxt-Main-Dialog-tl
         '(;;; edit boxes & toggles
           (DbxChgTxt-Drawing-Folder "eb_drawing_folder")
           (DbxChgTxt-Block-Names "eb_block_names")
           (DbxChgTxt-Old-Text "eb_old_text")
           (DbxChgTxt-New-Text "eb_new_text")
           (DbxChgTxt-Separator "eb_separator")
           
           (DbxChgTxt-Include-Subfolders "tg_include_subfolders")
           (DbxChgTxt-Include-Text "tg_include_text")
           (DbxChgTxt-Include-Attributes "tg_include_attributes")
           (DbxChgTxt-Include-Block-Text "tg_include_block_text")
           (DbxChgTxt-Case-Sensitive "tg_case_sensitive")
          )
  )
)

(defun DbxChgTxt_Main_Dialog_Action ()
  (mapcar '(lambda (x)(action_tile (car x) (cadr x)))
          '(("cancel" "(done_dialog 0)") 	("accept" "(done_dialog 1)")
            ;;; edit boxes & toggles
            ("eb_drawing_folder"		"(setq DbxChgTxt-Drawing-Folder $value)")
            ("eb_block_names"			"(setq DbxChgTxt-Block-Names $value)")
            ("eb_old_text"			"(setq DbxChgTxt-Old-Text $value)")
            ("eb_new_text"			"(setq DbxChgTxt-New-Text $value)")
            ("eb_separator"			"(setq DbxChgTxt-Separator $value)")
            
            ("eb_include_subfolders"		"(setq DbxChgTxt-Include-Subfolders $value)")
            ("tg_include_text"			"(setq DbxChgTxt-Include-Text $value)")
            ("tg_include_attributes"		"(setq DbxChgTxt-Include-Attributes $value)")
            ("tg_include_block_text"		"(setq DbxChgTxt-Include-Block-Text $value)")
            ("tg_case_sensitive"		"(setq DbxChgTxt-Case-Sensitive $value)")

            ;;; buttons
            ("bt_select_drawing_folder"		"(DbxChgTxt_Select_Drawing_Folder)")
            ("bt_block_from_current_drawing"	"(DbxChgTxt_Select_Block_From_Current_Drawing)")
            ("bt_block_from_external_drawing"	"(DbxChgTxt_Select_Block_From_External_Drawing)")
            
          ) ;;; end ' (quote list)
  );;; end mapcar
)

;;; --- dialog section ------------------------------------ end dialog section ------------------------------------- dialog section --- ;;;

(defun DbxChgTxt_Select_Drawing_Folder ( / fol)
  (if (setq fol (GetShellFolder "Select drawing folder"))
    (progn
      (set_tile "eb_drawing_folder" (setq DbxChgTxt-Drawing-Folder (Dos_Path fol)))
      (WriteSettingsToRegistry)
    )
  )
)

(defun DbxChgTxt_Select_Block_From_Current_Drawing ( / l dflt r)
  (if (not (vl-consp (setq l (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object))))))
    (alert "Computer says no (no blocks)")
    (progn
      ;;; (dplm l "Blocks in current drawing")
      ;;; check if there was a previous selection (DbxChgTxt-Block-Names)
      ;;; should be commatized like "Bk1,Bk2"
      (if (not (void DbxChgTxt-Block-Names))
        (setq dflt (de-commatize DbxChgTxt-Block-Names))(setq dflt '()))
      ;;; use * for all blocks
      (if (= (ascii DbxChgTxt-Block-Names) 42) (setq dflt l))
      ;;; feed blocklist current doc and default to multiple from list
      (if (setq r (mfl l dflt))
        (set_tile "eb_block_names" (setq DbxChgTxt-Block-Names (if (equal r l) "*" (commatize r)))))
      (WriteSettingsToRegistry)
    )
  )
)

;;; maybe	: add last-dbx-doc (text_part) or as default for next search
;;;		: * for all blocks
;;;		: button to edit (use editbox contents) as source for next mfl
;;;		  if list is long (de-commatize editbox & &feed to mfl)
(defun DbxChgTxt_Select_Block_From_External_Drawing ( / dwg doc l)
  (_InitObjectDBX)
  (if (setq dwg (getfiled "Select Drawing" (getvar "dwgprefix") "dwg" 0))
    (cond
      ((eq dwg (strcat (getvar "dwgprefix")(getvar "dwgname")))
       (alert "You've selected current drawing"))
      ((not (setq doc (odbx_open dwg)))
       (alert (strcat "Unable to open :\n" dwg)))
      ((not (vl-consp (setq l (GetDocBlockNames doc))))
       (alert (strcat "Found no blocks in :\n" dwg)))
      (t
       ;;; (dplm l (strcat "Blocks in " (cadr (fnsplitl dwg))))
       (if (not (void DbxChgTxt-Block-Names))
        (setq dflt (de-commatize DbxChgTxt-Block-Names))(setq dflt '()))
        ;;; feed blocklist current doc and default to multiple from list
        (if (setq r (mfl l dflt))
          (set_tile "eb_block_names" (setq DbxChgTxt-Block-Names (commatize r))))
        (WriteSettingsToRegistry)
      )
    )
    (alert "No drawing selected")
  )
  (odbx_close doc)
  ;(_ReleaseAll)
  ;;; (vl-catch-all-apply 'vlax-release-object (list doc))
  ;;; (if (and (= 'vla-object (type doc)) (not (vlax-object-released-p doc)))(vlax-release-object doc))
)



(defun c:t1 ()(c:DbxChgTxt))
(defun t1 ()(c:DbxChgTxt))

 

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...