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

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