Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

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

17 REPLIES 17
SOLVED
Reply
Message 1 of 18
jtm2020hyo
5214 Views, 17 Replies

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

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.

17 REPLIES 17
Message 2 of 18
dbhunia
in reply to: jtm2020hyo

Hi

 


@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.....


Debashis Bhunia
Co-Founder of Geometrifying Trigonometry(C)
________________________________________________
Walking is the First step of Running, Technique comes Next....
Message 3 of 18
Luís Augusto
in reply to: jtm2020hyo

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

Message 4 of 18
jtm2020hyo
in reply to: Luís Augusto

 

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.

image.png

 

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

image.png

Message 5 of 18
jtm2020hyo
in reply to: dbhunia

here I attached a 2007 version of the tested drawing.

image.png

Message 6 of 18
jtm2020hyo
in reply to: Luís Augusto


@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.

image.png

Message 7 of 18
jtm2020hyo
in reply to: Luís Augusto


@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)



Message 8 of 18
dbhunia
in reply to: jtm2020hyo

Hi

 

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.....

Capture.PNG

 

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)
)

 


Debashis Bhunia
Co-Founder of Geometrifying Trigonometry(C)
________________________________________________
Walking is the First step of Running, Technique comes Next....
Message 9 of 18
jtm2020hyo
in reply to: dbhunia

I tried to test your code. 

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

image.png


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

Message 10 of 18
cadffm
in reply to: jtm2020hyo

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.

Sebastian

EESignature

Message 11 of 18
Luís Augusto
in reply to: cadffm

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

Message 12 of 18


@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")

 

 

Message 13 of 18
jtm2020hyo
in reply to: Luís Augusto

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. 

image.png

Message 14 of 18
Luís Augusto
in reply to: jtm2020hyo

Please save the files in autoCAD 2013 version.

Thank you.

Message 15 of 18
jtm2020hyo
in reply to: Luís Augusto


@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 



Message 16 of 18
Luís Augusto
in reply to: jtm2020hyo

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")

 

Message 17 of 18
jtm2020hyo
in reply to: Luís Augusto


@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.



Message 18 of 18
Jason_Grubaugh
in reply to: jtm2020hyo

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"

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Forma Design Contest


Autodesk Design & Make Report