Lisp to Change to all Dimension Styles in one go and accross multiple files

[nicolas]

Hi,

 

I am looking for a lisp code that can execute 3 changes to variable in all the dimension styles namely:

 

1. Dimension Lines - Color set to 52

2. Extension Lines - Color set to 52

3. Text Appearance - Color set to 52

 

To push thing further, I also need to execute this lisp to all drawings in a specific folder.

 

Can anybody help me on this?

 

Thanks in advance.

 

Regards,

 

Nicolas

[nicolas]

Here is a Lee Mac's code that I modified slightly to meet my needs:

 

(defun c:tnm (/ dimlst doc ss)
 (vl-load-com)

 (setq dimlst '("1" "2" "3")) ;; Change as necessary
 
 (vlax-for dim (vla-get-Dimstyles
                 (setq doc
                   (vla-get-ActiveDocument
                     (vlax-get-acad-object))))
   (if (vl-position (vla-get-Name dim) dimlst)
     (progn
       (vla-put-activeDimstyle doc dim)
       (setvar "DIMCLRE" 52)
       (setvar "DIMCLRD" 52)
   (setvar "DIMCLRT" 52)
       (vla-copyfrom dim doc))))

 (if (setq ss (ssget "_X" '((0 . "DIMENSION"))))
   (mapcar 'vla-update
     (mapcar 'vlax-ename->vla-object
       (mapcar 'cadr (ssnamex ss)))))
 
 (princ))

 

There is a line that I want to change namely:

 

 (setq dimlst '("1" "2" "3")) ;; Change as necessary

 

It would be great if the application can list all the dimension styles automatically and save it to the variable dimlst.

[Dadgad]

This is not lisp, and no way that it will work as well as Lee's lisp,

 

but you can get pretty close to what you are after by configuring the STANDARDS options

and using a .dws file, while batch checking.

[Tharwat]

Check this out

 

(defun c:Test (/ d dim ss i obj)
 (vl-load-com)
 (cond ((not acdoc)
        (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
       )
 )
 (while (setq d (tblnext "DIMSTYLE" (null d)))
   (setq dim (vla-item (vla-get-Dimstyles
                         acdoc
                       )
                       (cdr (assoc 2 d))
             )
   )
   (vla-put-activeDimstyle acdoc dim)
   (setvar "DIMCLRE" 52)
   (setvar "DIMCLRD" 52)
   (setvar "DIMCLRT" 52)
   (vla-copyfrom dim acdoc)
 )
 (if (setq ss (ssget "_X" '((0 . "DIMENSION"))))
   (repeat (setq i (sslength ss))
     (setq obj (ssname ss (setq i (1- i))))
     (vla-update (vlax-ename->vla-object obj))
   )
 )
 (princ)
)

Edited May 12, 2012 by Tharwat
Another and better way of coding

[Lee Mac]

Hi nicolas,

 

That is some very old code of mine that you have discovered!

 

Here is how I might rewrite the function today:

 

(defun c:dimupd ( / adm doc sel styles )

   (setq styles '("1" "2" "3") ;; Dimension Styles to Update
         styles  (mapcar 'strcase styles)
   )
   (setq doc (vla-get-activedocument (vlax-get-acad-object))
         adm (vla-get-activedimstyle doc)
   )
   (vlax-for dim (vla-get-dimstyles doc)
       (if (member (strcase (vla-get-name dim)) styles)
           (progn
               (vla-put-activedimstyle doc dim)
               (setvar 'dimclre 52)
               (setvar 'dimclrd 52)
               (setvar 'dimclrt 52)
               (vla-copyfrom dim doc)
           )
       )
   )
   (if (ssget "_X" '((0 . "*DIMENSION")))
       (progn
           (vlax-for obj (setq sel (vla-get-activeselectionset doc))
               (vl-catch-all-apply 'vla-update (list obj))
           )
           (vla-delete sel)
       )
   )
   (vla-put-activedimstyle doc adm)
   (princ)
)
(vl-load-com) (princ)

[nicolas]

Thanks Lee Mac, Tharwat and Dadgad for the codes. Tharwat's code is working just fine. It applies the changes automatically to all the dimension styles irrespective of the names. Is there a way to incorporate that feature of Tharwat's code in Lee Mac's updated codes? Is there a way to automatically carry the instructions in this code to all drawings in a specific folder like in Lee Mac's Bfind lisp without using a script program like Script Pro? Or is there a program that can do even more than that in a library somewhere with DCL feature incorporated?

[nicolas]

Thanks DADGAD for the standard feature. I have read about it years ago and never really try it. I will do my best to learn of this feature as I believe it will be of great help to me.

[Lee Mac]

Oh, I thought you wanted to only modify certain styles, modifying all styles simplifies the code even more so:

 

(defun c:dimupd ( / adm doc sel )
   (setq doc (vla-get-activedocument (vlax-get-acad-object))
         adm (vla-get-activedimstyle doc)
   )
   (vlax-for dim (vla-get-dimstyles doc)
       (vla-put-activedimstyle doc dim)
       (setvar 'dimclre 52)
       (setvar 'dimclrd 52)
       (setvar 'dimclrt 52)
       (vla-copyfrom dim doc)
   )
   (if (ssget "_X" '((0 . "*DIMENSION")))
       (progn
           (vlax-for obj (setq sel (vla-get-activeselectionset doc))
               (vl-catch-all-apply 'vla-update (list obj))
           )
           (vla-delete sel)
       )
   )
   (vla-put-activedimstyle doc adm)
   (princ)
)
(vl-load-com) (princ)

[Tharwat]

Tharwat's code is working just fine. It applies the changes automatically to all the dimension styles irrespective of the names.

Is there a way to automatically carry the instructions in this code to all drawings in a specific folder .....

 

You're welcome , and happy to have my code working for you .

 

As a manipulation on the solution on the issue , try the following code from my routine and add it to your acaddoc.lsp or use command "appload" and add the code to Contents (briefcase ) to be able to run the code automatically on all new opening drawings. And after that open all your needed drawings and the code would do the trick , save and close each one a lone .

 

  (vl-load-com)
 (cond ((not acdoc)
        (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
       )
 )
 (while (setq d (tblnext "DIMSTYLE" (null d)))
   (setq dim (vla-item (vla-get-Dimstyles
                         acdoc
                       )
                       (cdr (assoc 2 d))
             )
   )
   (vla-put-activeDimstyle acdoc dim)
   (setvar "DIMCLRE" 52)
   (setvar "DIMCLRD" 52)
   (setvar "DIMCLRT" 52)
   (vla-copyfrom dim acdoc)
 )
 (if (setq ss (ssget "_X" '((0 . "DIMENSION"))))
   (repeat (setq i (sslength ss))
     (setq obj (ssname ss (setq i (1- i))))
     (vla-update (vlax-ename->vla-object obj))
   )
 )
 (princ)
(command "_.qsave")
(command "_.close")

When you finish detach the code from Autocad to avoid implementing the code on all new opening drawings .

[jamesjh]

This is awesome. What would I add in to change the text size, arrow size, text offset distance ?

[BIGAL]

Making a script is not hard !! you can get lisp to write it for you, the code you want is

 

open dwg1 (load "Tnm")(c:Tnm)close Y

open dwg2 (load "Tnm")(c:Tnm)close Y

open dwg3 (load "Tnm")(c:Tnm)close Y

 

I use CMD and Word and make them in a couple of minutes

 

Try this say dwgs are in c:\project\123

 

Go to start type CMD

CD Project\123

Dir *.dwg >Dir123.scr /b

exit

 

have a look at Dir123.scr it has all your dwg names in it, now using Word you can search replace ^p which is end of line and add the Open & (load "Tnm")(c:Tnm)close Y

All done

[3dwannab]

That is some very old code of mine that you have discovered!

Thanks for this. I just modified it to set the annotative flag to yes.

 

(defun c:dimupd ( / adm doc sel styles )

(setvar 'cmdecho 0)

(setq styles '("1" "2" "3") ;; Dimension Styles to Update
	styles  (mapcar 'strcase styles)
	)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
	adm (vla-get-activedimstyle doc)
	)
(vlax-for dim (vla-get-dimstyles doc)
	(if (member (strcase (vla-get-name dim)) styles)
		(progn
			(vla-put-activedimstyle doc dim)
			(setvar 'dimdli 10)
			(setvar 'dimfxl 10)
			(setvar 'dimrnd 1)
			(vl-cmdf "-dimstyle" "an" "yes" "?" (vla-get-name dim) (vla-get-name dim) "y" "a" "")
			(princ (strcat "\nUpdated '" (vla-get-name dim) "' Dimension Style.\n"))
			(vla-copyfrom dim doc)
			)
		)
	)
(if (ssget "_X" '((0 . "*DIMENSION")))
	(progn
		(vlax-for obj (setq sel (vla-get-activeselectionset doc))
			(vl-catch-all-apply 'vla-update (list obj))
			)
		(vla-delete sel)
		)
	)
(vla-put-activedimstyle doc adm)
(princ)
)
(vl-load-com) (princ)

Edited July 21, 2018 by 3dwannab