Jump to content

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


nicolas

Recommended Posts

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Standards configuration.JPG

Link to comment
Share on other sites

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 by Tharwat
Another and better way of coding
Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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)

  • Thanks 1
Link to comment
Share on other sites

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 .

Link to comment
Share on other sites

  • 2 years later...

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

Link to comment
Share on other sites

  • 3 years later...
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 by 3dwannab
Link to comment
Share on other sites

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.

×
×
  • Create New...