topic Re: Request for a Lisp to batch change all drawing text styles to any style in Visual LISP, AutoLISP and General Customization Forum

Request for a Lisp to batch change all drawing text styles to any style

jtm2020hyo — Wed, 21 Nov 2018 16:48:21 GMT

I need to change multiple text styles from files with multiple blocks I will take a lot of time _exploding and changing all styles to ROMANS (what I need for this case).

Can anyone share me a LISP to change all styles from multiple drawings at the same time?

PD: I already tested a lot of LISPs from google but no one of those work, for a file or a folder.

Re: Request for a Lisp to batch change all drawing text styles to any style

dbhunia — Wed, 21 Nov 2018 17:19:41 GMT

@jtm2020hyo wrote:

I need to change multiple text styles from files with multiple blocks I will take a lot of time _exploding and changing all styles to ROMANS (what I need for this case).

Can anyone share me a LISP to change all styles from multiple drawings at the same time?

PD: I already tested a lot of LISPs from google but no one of those work, for a file or a folder.

For the above highlighted point explain with attachment ........ with a file before changing all text styles And after changing all text styles in that file (two file separately)..... in AutoCAD 2007 format.....

Re: Request for a Lisp to batch change all drawing text styles to any style

Luís Augusto — Wed, 21 Nov 2018 17:25:47 GMT

Hello,
Try this routine and let us know if it worked.

Best regards, Luís Augusto

http://www.theswamp.org/index.php?topic=17659.0

Re: Request for a Lisp to batch change all drawing text styles to any style

jtm2020hyo — Wed, 21 Nov 2018 20:14:00 GMT

drawing tested in attached.

Sr, how can I load .dcl and .lsp file?

I already tried to put both files in the same folder and load .lsp file.

I cant make work that lisp code. maybe I'm doing something bad.

Re: Request for a Lisp to batch change all drawing text styles to any style

jtm2020hyo — Wed, 21 Nov 2018 20:16:24 GMT

here I attached a 2007 version of the tested drawing.

Re: Request for a Lisp to batch change all drawing text styles to any style

jtm2020hyo — Wed, 21 Nov 2018 21:36:27 GMT

@Luís Augusto wrote:

Hello,
Try this routine and let us know if it worked.

Best regards, Luís Augusto

http://www.theswamp.org/index.php?topic=17659.0

Lisp work perfectly.
thanks for your help.

what I did was load .dcl file to Autocad 2018 path.

Re: Request for a Lisp to batch change all drawing text styles to any style

jtm2020hyo — Wed, 21 Nov 2018 21:42:18 GMT

@Luís Augusto wrote:

Hello,
Try this routine and let us know if it worked.

Best regards, Luís Augusto

http://www.theswamp.org/index.php?topic=17659.0

...I still have a problem more. I need change text, mtext, rtext, dtext and attributes styles from multiple files.

how can I merge multiples styles from multiple drawing? (Batch merge)

Re: Request for a Lisp to batch change all drawing text styles to any style

dbhunia — Thu, 22 Nov 2018 12:20:58 GMT

What I get from your last post ......... (and also your attached drawing).....

1 First have to create a Text Style named "ROMANS" ......with below properties.....

2 Then change all text, mtext, rtext, dtext .....styles to that style named "ROMANS"......

Then try this........

First put all the drawings in a single folder & run the code it will ask to select the Folder Containing the drawings you just select the folder & move forward......Code will work itself on all the drawings in side that folder.....

But before running the Lisp make sure about two things-

1. There is only one Drawing is open (other than any drawing which one you want to edit), otherwise SDI Variable can not be reset.

2. Wait for complete execution of the command, otherwise SDI Variable will not restored back.

(defun c:CTS ( / sh folder folderobject result)

   (vl-load-com)
   (setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application" ))
   (setq folder (vlax-invoke-method sh 'BrowseForFolder 0 "" 0 ))
   (vlax-release-object sh)
   (setq SDI_Val (getvar "SDI"))
   (setq LISPI_Val (getvar "LISPINIT"))
   (vl-cmdf "SDI" 1)
   (vl-cmdf "LISPINIT" 0)
   (if folder
      (progn
         (setq folderobject (vlax-get-property folder 'Self))
         (setq result (vlax-get-property FolderObject 'Path))
         (vlax-release-object folder)
         (vlax-release-object FolderObject)

	(setq Files_Folder (vl-directory-files result "*.dwg"))
	(command "save" (strcat (getvar "dwgprefix") (getvar "dwgname")) "Y")
	(setq NO 0)

	(while (< NO (length Files_Folder))

	(command "fileopen" (strcat result "\\" (nth NO Files_Folder)))

	(entmake (list
             	'(0 . "STYLE")
		'(100 . "AcDbSymbolTableRecord")
		'(100 . "AcDbTextStyleTableRecord")
             	(cons 2 "ROMANS");Text Style Name
		'(70 . 0)
	        '(40 . 0.0)
                '(41 . 1.0)
		'(50 . 0.0)
		'(71 . 0)
		'(42 . 0.09375)
             	(cons 3 "C:\\Windows\\Fonts\\romans.shx")
		'(4 . "")
           	)
	)
	(Setq selectionset (ssget "_A" '((0 . "*TEXT"))))
	(repeat (setq N (sslength selectionset))
		(setq Data (ssname selectionset (setq N (- N 1))))
		(setq EntityData (entget Data))
		(setq Text_Style (cdr (assoc 7 EntityData)))
			(if (/= Text_Style "ROMANS")
				  (entmod (subst (cons 7 "ROMANS")(assoc 7 EntityData)EntityData))
			)
	)

	(vl-cmdf "save" (strcat result "\\" (nth NO Files_Folder)))
	(setq NO (+ 1 NO))
        )
     )
   )
(vl-cmdf "SDI" SDI_Val)
(vl-cmdf "LISPINIT" LISPI_Val)
)

Re: Request for a Lisp to batch change all drawing text styles to any style

jtm2020hyo — Thu, 22 Nov 2018 21:19:25 GMT

I tried to test your code.

I received this "Cannot run FILEOPEN if SDI mode cannot be established." :

If you need more testing from me, let me know I will help much how I can. Or let me know if i did something bad

Re: Request for a Lisp to batch change all drawing text styles to any style

cadffm — Thu, 22 Nov 2018 21:25:08 GMT

You are not in SDI-mode, check your log 6-7 lines above.

Issue: You have more than one file open, so you can not go to sdi-mode,

close all files except one of them, then try it again.

Re: Request for a Lisp to batch change all drawing text styles to any style

Luís Augusto — Thu, 22 Nov 2018 22:03:20 GMT

I would try to use ObjectDBX but I'm totally busy right now.

Below is the reference of how I would do it:

http://www.lee-mac.com/odbxbase.html

Example 4

Re: Request for a Lisp to batch change all drawing text styles to any style

Luís Augusto — Fri, 23 Nov 2018 17:32:30 GMT

@Luís Augusto wrote:

I would try to use ObjectDBX but I'm totally busy right now.

Using ObjectDBX:
Enter "test" on the command line, choose the folder where all the files are located.
Attention!
The routine changes the files and there is no way to reverse the process, so create a copy of your folder before performing the action.

Best regards, Luís Augusto

;;-----------------------=={ ObjectDBX Wrapper }==----------------------;;
;;                                                                      ;;
;;  Evaluates a supplied function on all drawings in a given list or    ;;
;;  selected directory.                                                 ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Arguments:                                                          ;;
;;                                                                      ;;
;;  fun [SYM]                                                           ;;
;;  ---------------------------------                                   ;;
;;  A function requiring a single argument (the VLA Document object),   ;;
;;  and following the 'rules' of ObjectDBX:                             ;;
;;                                                                      ;;
;;  - No SelectionSets               (ssget, ssname, ssdel, etc)        ;;
;;  - No Command Calls               (command "_.line" ... etc)         ;;
;;  - No ent* methods                (entget, entmod, entupd, etc)      ;;
;;  - No Access to System Variables  (setvar, getvar, setvariable, etc) ;;
;;                                                                      ;;
;;  lst [LIST] [Optional]                                               ;;
;;  ---------------------------------                                   ;;
;;  List of DWG Filenames; if nil, BrowseForFolder Dialog is displayed. ;;
;;                                                                      ;;
;;  sav [SYM]                                                           ;;
;;  ---------------------------------                                   ;;
;;  Boolean flag determining whether drawings should be saved following ;;
;;  function evaluation (T=saved, nil=not saved).                       ;;
;;----------------------------------------------------------------------;;
;;  Returns:                                                            ;;
;;                                                                      ;;
;;  List of:                                                            ;;
;;  (                                                                   ;;
;;      (<Drawing Filename> . <Function Result>)                        ;;
;;      (<Drawing Filename> . <Function Result>)                        ;;
;;      ...                                                             ;;
;;      (<Drawing Filename> . <Function Result>)                        ;;
;;  )                                                                   ;;
;;                                                                      ;;
;;  Where:                                                              ;;
;;  <Drawing Filename>                                                  ;;
;;  is the filename of drawing that has been processed.                 ;;
;;                                                                      ;;
;;  <Function Result>                                                   ;;
;;  is the result of evaluating the supplied function on the Document   ;;
;;  Object representing the associated drawing filename.                ;;
;;                                                                      ;;
;;  If an error occurs when evaluating the supplied function the        ;;
;;  Function Result will be nil and the error message will be printed   ;;
;;  to the command-line.                                                ;;
;;----------------------------------------------------------------------;;

(defun LM:ODBX ( fun lst sav / *error* app dbx dir doc dwl err rtn vrs )

    (defun *error* ( msg )
        (if (and (= 'vla-object (type dbx)) (not (vlax-object-released-p dbx)))
            (vlax-release-object dbx)
        )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (cond
        (   (not
                (or lst
                    (and (setq dir (LM:browseforfolder "Select Folder of Drawings to Process" nil 512))
                         (setq lst (mapcar '(lambda ( x ) (strcat dir "\\" x)) (vl-directory-files dir "*.dwg" 1)))
                    )
                )
            )
            nil
        )
        (   (progn
                (setq dbx
                    (vl-catch-all-apply 'vla-getinterfaceobject
                        (list (setq app (vlax-get-acad-object))
                            (if (< (setq vrs (atoi (getvar 'acadver))) 16)
                                "objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs))
                            )
                        )
                    )
                )
                (or (null dbx) (vl-catch-all-error-p dbx))
            )
            (prompt "\nUnable to interface with ObjectDBX.")
        )
        (   t
            (vlax-for doc (vla-get-documents app)
                (setq dwl (cons (cons (strcase (vla-get-fullname doc)) doc) dwl))
            )
            (foreach dwg lst
                (if (or (setq doc (cdr (assoc (strcase dwg) dwl)))
                        (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbx dwg))))
                             (setq doc dbx)
                        )
                    )
                    (progn
                        (setq rtn
                            (cons
                                (cons dwg
                                    (if (vl-catch-all-error-p (setq err (vl-catch-all-apply fun (list doc))))
                                        (prompt (strcat "\n" dwg "\t" (vl-catch-all-error-message err)))
                                        err
                                    )
                                )
                                rtn
                            )
                        )
                        (if sav (vla-saveas doc dwg))
                    )
                    (princ (strcat "\nError opening file: " (vl-filename-base dwg) ".dwg"))
                )
            )
            (if (= 'vla-object (type dbx))
                (vlax-release-object dbx)
            )
            (reverse rtn)
        )
    )
)

;;------------------=={ Browse for Folder }==-----------------;;
;;                                                            ;;
;;  Displays a dialog prompting the user to select a folder.  ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg - message to display at top of dialog                 ;;
;;  dir - root directory (or nil)                             ;;
;;  flg - bit-coded flag specifying dialog display settings   ;;
;;------------------------------------------------------------;;
;;  Returns:  Selected folder filepath, else nil.             ;;
;;------------------------------------------------------------;;

(defun LM:browseforfolder ( msg dir flg / err fld pth shl slf )
    (setq err
        (vl-catch-all-apply
            (function
                (lambda ( / app hwd )
                    (if (setq app (vlax-get-acad-object)
                              shl (vla-getinterfaceobject app "shell.application")
                              hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
                              fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg flg dir)
                        )
                        (setq slf (vlax-get-property fld 'self)
                              pth (vlax-get-property slf 'path)
                              pth (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth))
                        )
                    )
                )
            )
        )
    )
    (if slf (vlax-release-object slf))
    (if fld (vlax-release-object fld))
    (if shl (vlax-release-object shl))
    (if (vl-catch-all-error-p err)
        (prompt (vl-catch-all-error-message err))
        pth
    )
)

(defun c:test (/ _getattributes data file name)

  (defun Make_ChangeTextStyle (doc / success)
    (if
      (not
	(vl-catch-all-error-p
	  (setq
	    NewTextStyleObj
	     (vl-catch-all-apply
	       'vla-add
	       (list
		 (vla-get-textstyles
		   doc
		 )
		 "NEW_ROMANS_STYLE"
	       )
	     )
	  )
	)
      )
       (progn
	 (vla-put-FontFile
	   NewTextStyleObj
	   "romans.shx"
	 )
	 (vla-put-Width
	   NewTextStyleObj
	   1.0
	 )
	 (vla-put-ObliqueAngle		;radians
	   NewTextStyleObj
	   0.0
	 )
	 (setq success T)
       )
    )

    (if	success
      (progn
	(vlax-for layout (vla-get-layouts doc)
	  (vlax-for object (vla-get-block layout)
	    (if	(vlax-property-available-p object "StyleName")
	      (vla-put-stylename object "NEW_ROMANS_STYLE")
	    )
	  )
	)
	(vlax-for objBlock (vla-get-blocks doc)
	  (if (> (vla-get-count objBlock) 0)
	    (progn
	      (setq objItem (vla-item objBlock 0)
		    entItem (vlax-vla-object->ename objItem)
	      )
	      (while entItem
		(if
		  (vlax-property-available-p
		    (setq objItem (vlax-ename->vla-object entItem))
		    "StyleName"
		  )
		   (vla-put-stylename objItem "NEW_ROMANS_STYLE")
		)
		(setq entItem (entnext entItem))
	      )
	    )
	  )
	)
      )
    )
  )

  (LM:ODBX 'Make_ChangeTextStyle nil t)
  
  (princ)
)

(vl-load-com) (princ "C:TEST")

Re: Request for a Lisp to batch change all drawing text styles to any style

jtm2020hyo — Fri, 23 Nov 2018 19:48:47 GMT

I tested in a folder but nothing changed. Maybe I did something bad? check image, please.

PD: I attached 3 files where I'm testing this code.

Re: Request for a Lisp to batch change all drawing text styles to any style

Luís Augusto — Sat, 24 Nov 2018 13:36:29 GMT

Please save the files in autoCAD 2013 version.

Thank you.

Re: Request for a Lisp to batch change all drawing text styles to any style

jtm2020hyo — Sat, 24 Nov 2018 18:11:12 GMT

@Luís Augusto wrote:

Please save the files in autoCAD 2013 version.

Thank you.

here attached files where I need work in version AutoCAD 2013

Re: Request for a Lisp to batch change all drawing text styles to any style

Luís Augusto — Mon, 26 Nov 2018 19:10:04 GMT

This new version worked for me.
Could test and tell me if it works for you?

Unfortunately the block with the name "CODIGO" that is in the "0.1 ESTACIONAMIENTO" drawing requires the "ATTSYNC" command that is not available in ObjectDBX.

Best Regards, Luís Augusto

;;-----------------------=={ ObjectDBX Wrapper }==----------------------;;
;;                                                                      ;;
;;  Evaluates a supplied function on all drawings in a given list or    ;;
;;  selected directory.                                                 ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Arguments:                                                          ;;
;;                                                                      ;;
;;  fun [SYM]                                                           ;;
;;  ---------------------------------                                   ;;
;;  A function requiring a single argument (the VLA Document object),   ;;
;;  and following the 'rules' of ObjectDBX:                             ;;
;;                                                                      ;;
;;  - No SelectionSets               (ssget, ssname, ssdel, etc)        ;;
;;  - No Command Calls               (command "_.line" ... etc)         ;;
;;  - No ent* methods                (entget, entmod, entupd, etc)      ;;
;;  - No Access to System Variables  (setvar, getvar, setvariable, etc) ;;
;;                                                                      ;;
;;  lst [LIST] [Optional]                                               ;;
;;  ---------------------------------                                   ;;
;;  List of DWG Filenames; if nil, BrowseForFolder Dialog is displayed. ;;
;;                                                                      ;;
;;  sav [SYM]                                                           ;;
;;  ---------------------------------                                   ;;
;;  Boolean flag determining whether drawings should be saved following ;;
;;  function evaluation (T=saved, nil=not saved).                       ;;
;;----------------------------------------------------------------------;;
;;  Returns:                                                            ;;
;;                                                                      ;;
;;  List of:                                                            ;;
;;  (                                                                   ;;
;;      (<Drawing Filename> . <Function Result>)                        ;;
;;      (<Drawing Filename> . <Function Result>)                        ;;
;;      ...                                                             ;;
;;      (<Drawing Filename> . <Function Result>)                        ;;
;;  )                                                                   ;;
;;                                                                      ;;
;;  Where:                                                              ;;
;;  <Drawing Filename>                                                  ;;
;;  is the filename of drawing that has been processed.                 ;;
;;                                                                      ;;
;;  <Function Result>                                                   ;;
;;  is the result of evaluating the supplied function on the Document   ;;
;;  Object representing the associated drawing filename.                ;;
;;                                                                      ;;
;;  If an error occurs when evaluating the supplied function the        ;;
;;  Function Result will be nil and the error message will be printed   ;;
;;  to the command-line.                                                ;;
;;----------------------------------------------------------------------;;

(defun LM:ODBX (fun lst sav / *error* app dbx dir doc dwl err rtn vrs)

  (defun *error* (msg)
    (if	(and (= 'vla-object (type dbx))
	     (not (vlax-object-released-p dbx))
	)
      (vlax-release-object dbx)
    )
    (if	(not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  (cond
    ((not
       (or lst
	   (and	(setq dir (LM:browseforfolder
			    "Select Folder of Drawings to Process"
			    nil
			    512
			  )
		)
		(setq lst (mapcar '(lambda (x) (strcat dir "\\" x))
				  (vl-directory-files dir "*.dwg" 1)
			  )
		)
	   )
       )
     )
     nil
    )
    ((progn
       (setq dbx
	      (vl-catch-all-apply
		'vla-getinterfaceobject
		(list (setq app (vlax-get-acad-object))
		      (if (< (setq vrs (atoi (getvar 'acadver))) 16)
			"objectdbx.axdbdocument"
			(strcat "objectdbx.axdbdocument." (itoa vrs))
		      )
		)
	      )
       )
       (or (null dbx) (vl-catch-all-error-p dbx))
     )
     (prompt "\nUnable to interface with ObjectDBX.")
    )
    (t
     (vlax-for doc (vla-get-documents app)
       (setq dwl (cons (cons (strcase (vla-get-fullname doc)) doc) dwl))
     )
     (foreach dwg lst
       (if
	 (or (setq doc (cdr (assoc (strcase dwg) dwl)))
	     (and (not (vl-catch-all-error-p
			 (vl-catch-all-apply 'vla-open (list dbx dwg))
		       )
		  )
		  (setq doc dbx)
	     )
	 )
	  (progn
	    (setq rtn
		   (cons
		     (cons dwg
			   (if (vl-catch-all-error-p
				 (setq err (vl-catch-all-apply fun (list doc)))
			       )
			     (prompt (strcat "\n"
					     dwg
					     "\t"
					     (vl-catch-all-error-message err)
				     )
			     )
			     err
			   )
		     )
		     rtn
		   )
	    )
	    (if	sav
	      (vla-saveas doc dwg)
	    )
	  )
	  (princ (strcat "\nError opening file: "
			 (vl-filename-base dwg)
			 ".dwg"
		 )
	  )
       )
     )
     (if (= 'vla-object (type dbx))
       (vlax-release-object dbx)
     )
     (reverse rtn)
    )
  )
)

;;------------------=={ Browse for Folder }==-----------------;;
;;                                                            ;;
;;  Displays a dialog prompting the user to select a folder.  ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg - message to display at top of dialog                 ;;
;;  dir - root directory (or nil)                             ;;
;;  flg - bit-coded flag specifying dialog display settings   ;;
;;------------------------------------------------------------;;
;;  Returns:  Selected folder filepath, else nil.             ;;
;;------------------------------------------------------------;;

(defun LM:browseforfolder (msg dir flg / err fld pth shl slf)
  (setq	err
	 (vl-catch-all-apply
	   (function
	     (lambda (/ app hwd)
	       (if (setq app (vlax-get-acad-object)
			 shl (vla-getinterfaceobject app "shell.application")
			 hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
			 fld (vlax-invoke-method
			       shl
			       'browseforfolder
			       (if (vl-catch-all-error-p hwd)
				 0
				 hwd
			       )
			       msg
			       flg
			       dir
			     )
		   )
		 (setq slf (vlax-get-property fld 'self)
		       pth (vlax-get-property slf 'path)
		       pth (vl-string-right-trim
			     "\\"
			     (vl-string-translate "/" "\\" pth)
			   )
		 )
	       )
	     )
	   )
	 )
  )
  (if slf
    (vlax-release-object slf)
  )
  (if fld
    (vlax-release-object fld)
  )
  (if shl
    (vlax-release-object shl)
  )
  (if (vl-catch-all-error-p err)
    (prompt (vl-catch-all-error-message err))
    pth
  )
)

(defun c:test (/ _getattributes data file name)

  (defun Make_ChangeTextStyle (doc / success)

    (if
      (not
	(vl-catch-all-error-p
	  (setq
	    NewTextStyleObj
	     (vl-catch-all-apply
	       'vla-add
	       (list
		 (vla-get-textstyles
		   doc
		 )
		 "NEW_ROMANS_STYLE"
	       )
	     )
	  )
	)
      )
       (progn
	 (vla-put-FontFile
	   NewTextStyleObj
	   "romans.shx"
	 )
	 (vla-put-Width
	   NewTextStyleObj
	   1.0
	 )
	 (vla-put-ObliqueAngle		;radians
	   NewTextStyleObj
	   0.0
	 )
	 (setq success T)
       )
    )

    (if	success
      (progn
	(if ACET-UI-PROGRESS-DONE
	  (ACET-UI-PROGRESS-DONE)
	)
	(setq i 0)
	(if acet-ui-progress
	  (acet-ui-progress-init
	    (strcat (vla-get-Name doc) " - Processing Objects...")
	    (vla-get-Count (vla-get-blocks doc))
	  )
	)
	(vlax-for objBlock (vla-get-blocks doc)
	  (if acet-ui-progress
	    (acet-ui-progress-safe (setq i (1+ i)))
	  )

	  (if (> (vla-get-count objBlock) 0)
	    (progn
	      (setq objItem (vla-item objBlock 0)
		    entItem (vlax-vla-object->ename objItem)
	      )
	      (while entItem

		(if
		  (vlax-property-available-p
		    (setq object (vlax-ename->vla-object entItem))
		    "StyleName"
		  )
		   (cond
		     (
		      (or
			(wcmatch (vla-get-ObjectName object)
				 "*Dimension"
			)
			(= (vla-get-ObjectName object) "AcDbLeader")
		      )
		      (vl-catch-all-apply
			'vla-put-TextStyle
			(list
			  object
			  "NEW_ROMANS_STYLE"
			)
		      )
		      (vla-Update object)
		     )
		     (
		      (member
			(vla-get-ObjectName object)
			'("AcDbText"
			  "AcDbMText"
			  "AcDbAttributeDefinition"
			  "AcDbAttributeReference"
			 )
		      )
		      (vl-catch-all-apply
			'vla-put-stylename
			(list
			  object
			  "NEW_ROMANS_STYLE"
			)
		      )
		      (vla-Update object)
		     )
		   )
		)
		(setq entItem (entnext entItem))
	      )
	    )
	  )
	)
	(if ACET-UI-PROGRESS-DONE
	  (ACET-UI-PROGRESS-DONE)
	)
      )
    )
  )

  (LM:ODBX 'Make_ChangeTextStyle nil t)
  (princ "Processing completed")
  (princ)
)

(vl-load-com)
(princ "C:TEST")

Re: Request for a Lisp to batch change all drawing text styles to any style

jtm2020hyo — Wed, 28 Nov 2018 20:03:59 GMT

@Luís Augusto wrote:

This new version worked for me.
Could test and tell me if it works for you?

Unfortunately the block with the name "CODIGO" that is in the "0.1 ESTACIONAMIENTO" drawing requires the "ATTSYNC" command that is not available in ObjectDBX.

Best Regards, Luís Augusto

;;-----------------------=={ ObjectDBX Wrapper }==----------------------;;
;;                                                                      ;;
;;  Evaluates a supplied function on all drawings in a given list or    ;;
;;  selected directory.                                                 ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Arguments:                                                          ;;
;;                                                                      ;;
;;  fun [SYM]                                                           ;;
;;  ---------------------------------                                   ;;
;;  A function requiring a single argument (the VLA Document object),   ;;
;;  and following the 'rules' of ObjectDBX:                             ;;
;;                                                                      ;;
;;  - No SelectionSets               (ssget, ssname, ssdel, etc)        ;;
;;  - No Command Calls               (command "_.line" ... etc)         ;;
;;  - No ent* methods                (entget, entmod, entupd, etc)      ;;
;;  - No Access to System Variables  (setvar, getvar, setvariable, etc) ;;
;;                                                                      ;;
;;  lst [LIST] [Optional]                                               ;;
;;  ---------------------------------                                   ;;
;;  List of DWG Filenames; if nil, BrowseForFolder Dialog is displayed. ;;
;;                                                                      ;;
;;  sav [SYM]                                                           ;;
;;  ---------------------------------                                   ;;
;;  Boolean flag determining whether drawings should be saved following ;;
;;  function evaluation (T=saved, nil=not saved).                       ;;
;;----------------------------------------------------------------------;;
;;  Returns:                                                            ;;
;;                                                                      ;;
;;  List of:                                                            ;;
;;  (                                                                   ;;
;;      (<Drawing Filename> . <Function Result>)                        ;;
;;      (<Drawing Filename> . <Function Result>)                        ;;
;;      ...                                                             ;;
;;      (<Drawing Filename> . <Function Result>)                        ;;
;;  )                                                                   ;;
;;                                                                      ;;
;;  Where:                                                              ;;
;;  <Drawing Filename>                                                  ;;
;;  is the filename of drawing that has been processed.                 ;;
;;                                                                      ;;
;;  <Function Result>                                                   ;;
;;  is the result of evaluating the supplied function on the Document   ;;
;;  Object representing the associated drawing filename.                ;;
;;                                                                      ;;
;;  If an error occurs when evaluating the supplied function the        ;;
;;  Function Result will be nil and the error message will be printed   ;;
;;  to the command-line.                                                ;;
;;----------------------------------------------------------------------;;

(defun LM:ODBX (fun lst sav / *error* app dbx dir doc dwl err rtn vrs)

  (defun *error* (msg)
    (if	(and (= 'vla-object (type dbx))
	     (not (vlax-object-released-p dbx))
	)
      (vlax-release-object dbx)
    )
    (if	(not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  (cond
    ((not
       (or lst
	   (and	(setq dir (LM:browseforfolder
			    "Select Folder of Drawings to Process"
			    nil
			    512
			  )
		)
		(setq lst (mapcar '(lambda (x) (strcat dir "\\" x))
				  (vl-directory-files dir "*.dwg" 1)
			  )
		)
	   )
       )
     )
     nil
    )
    ((progn
       (setq dbx
	      (vl-catch-all-apply
		'vla-getinterfaceobject
		(list (setq app (vlax-get-acad-object))
		      (if (< (setq vrs (atoi (getvar 'acadver))) 16)
			"objectdbx.axdbdocument"
			(strcat "objectdbx.axdbdocument." (itoa vrs))
		      )
		)
	      )
       )
       (or (null dbx) (vl-catch-all-error-p dbx))
     )
     (prompt "\nUnable to interface with ObjectDBX.")
    )
    (t
     (vlax-for doc (vla-get-documents app)
       (setq dwl (cons (cons (strcase (vla-get-fullname doc)) doc) dwl))
     )
     (foreach dwg lst
       (if
	 (or (setq doc (cdr (assoc (strcase dwg) dwl)))
	     (and (not (vl-catch-all-error-p
			 (vl-catch-all-apply 'vla-open (list dbx dwg))
		       )
		  )
		  (setq doc dbx)
	     )
	 )
	  (progn
	    (setq rtn
		   (cons
		     (cons dwg
			   (if (vl-catch-all-error-p
				 (setq err (vl-catch-all-apply fun (list doc)))
			       )
			     (prompt (strcat "\n"
					     dwg
					     "\t"
					     (vl-catch-all-error-message err)
				     )
			     )
			     err
			   )
		     )
		     rtn
		   )
	    )
	    (if	sav
	      (vla-saveas doc dwg)
	    )
	  )
	  (princ (strcat "\nError opening file: "
			 (vl-filename-base dwg)
			 ".dwg"
		 )
	  )
       )
     )
     (if (= 'vla-object (type dbx))
       (vlax-release-object dbx)
     )
     (reverse rtn)
    )
  )
)

;;------------------=={ Browse for Folder }==-----------------;;
;;                                                            ;;
;;  Displays a dialog prompting the user to select a folder.  ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg - message to display at top of dialog                 ;;
;;  dir - root directory (or nil)                             ;;
;;  flg - bit-coded flag specifying dialog display settings   ;;
;;------------------------------------------------------------;;
;;  Returns:  Selected folder filepath, else nil.             ;;
;;------------------------------------------------------------;;

(defun LM:browseforfolder (msg dir flg / err fld pth shl slf)
  (setq	err
	 (vl-catch-all-apply
	   (function
	     (lambda (/ app hwd)
	       (if (setq app (vlax-get-acad-object)
			 shl (vla-getinterfaceobject app "shell.application")
			 hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
			 fld (vlax-invoke-method
			       shl
			       'browseforfolder
			       (if (vl-catch-all-error-p hwd)
				 0
				 hwd
			       )
			       msg
			       flg
			       dir
			     )
		   )
		 (setq slf (vlax-get-property fld 'self)
		       pth (vlax-get-property slf 'path)
		       pth (vl-string-right-trim
			     "\\"
			     (vl-string-translate "/" "\\" pth)
			   )
		 )
	       )
	     )
	   )
	 )
  )
  (if slf
    (vlax-release-object slf)
  )
  (if fld
    (vlax-release-object fld)
  )
  (if shl
    (vlax-release-object shl)
  )
  (if (vl-catch-all-error-p err)
    (prompt (vl-catch-all-error-message err))
    pth
  )
)

(defun c:test (/ _getattributes data file name)

  (defun Make_ChangeTextStyle (doc / success)

    (if
      (not
	(vl-catch-all-error-p
	  (setq
	    NewTextStyleObj
	     (vl-catch-all-apply
	       'vla-add
	       (list
		 (vla-get-textstyles
		   doc
		 )
		 "NEW_ROMANS_STYLE"
	       )
	     )
	  )
	)
      )
       (progn
	 (vla-put-FontFile
	   NewTextStyleObj
	   "romans.shx"
	 )
	 (vla-put-Width
	   NewTextStyleObj
	   1.0
	 )
	 (vla-put-ObliqueAngle		;radians
	   NewTextStyleObj
	   0.0
	 )
	 (setq success T)
       )
    )

    (if	success
      (progn
	(if ACET-UI-PROGRESS-DONE
	  (ACET-UI-PROGRESS-DONE)
	)
	(setq i 0)
	(if acet-ui-progress
	  (acet-ui-progress-init
	    (strcat (vla-get-Name doc) " - Processing Objects...")
	    (vla-get-Count (vla-get-blocks doc))
	  )
	)
	(vlax-for objBlock (vla-get-blocks doc)
	  (if acet-ui-progress
	    (acet-ui-progress-safe (setq i (1+ i)))
	  )

	  (if (> (vla-get-count objBlock) 0)
	    (progn
	      (setq objItem (vla-item objBlock 0)
		    entItem (vlax-vla-object->ename objItem)
	      )
	      (while entItem

		(if
		  (vlax-property-available-p
		    (setq object (vlax-ename->vla-object entItem))
		    "StyleName"
		  )
		   (cond
		     (
		      (or
			(wcmatch (vla-get-ObjectName object)
				 "*Dimension"
			)
			(= (vla-get-ObjectName object) "AcDbLeader")
		      )
		      (vl-catch-all-apply
			'vla-put-TextStyle
			(list
			  object
			  "NEW_ROMANS_STYLE"
			)
		      )
		      (vla-Update object)
		     )
		     (
		      (member
			(vla-get-ObjectName object)
			'("AcDbText"
			  "AcDbMText"
			  "AcDbAttributeDefinition"
			  "AcDbAttributeReference"
			 )
		      )
		      (vl-catch-all-apply
			'vla-put-stylename
			(list
			  object
			  "NEW_ROMANS_STYLE"
			)
		      )
		      (vla-Update object)
		     )
		   )
		)
		(setq entItem (entnext entItem))
	      )
	    )
	  )
	)
	(if ACET-UI-PROGRESS-DONE
	  (ACET-UI-PROGRESS-DONE)
	)
      )
    )
  )

  (LM:ODBX 'Make_ChangeTextStyle nil t)
  (princ "Processing completed")
  (princ)
)

(vl-load-com)
(princ "C:TEST")

recently I code and work perfectly. thanks a lot.

Re: Request for a Lisp to batch change all drawing text styles to any style

Jason_Grubaugh — Fri, 27 Oct 2023 15:39:24 GMT

I wanted to see if there was a way to modify this script so that you're only changing a singular text style in a batch of dwg files within a singular folder. The issue we have is that a text style was defined incorrectly in a template using a bolded font - but it should be regular. trying to use a lisp or something to do it en mass vs opening up 50 dwg files in this specific project but anywhere else it has occurred too.

so for example - the lisp would still launch the same by letting you select the folder that contains all the dwg files, but instead of moving everything to "TEXT UPDATED", it would only change objects using "TEXT BOLD"