Save copy of drawing to another folder without xrefs

jens.tornblad · ‎10-23-2015

Hi!

We have a certain process at our workplace where we have a working folder and a folder where we save the most recent version of the file without xrefs. We also have an old folder where the previous version of the drawing in the recent folder is moved to.

Is it possible to automate this proccess with a script?

What we need is:

All xrefs detached
UCS world
Save a copy of the drawing with the same name to the "recent" folder and also move the (if) existing file to "old" with the same name but _YYMMDD at the end.
Keep the "working" drawing open in Autocad

Ultimately this would all be achieved with a keyboard shortcut.

Is this possible?

Thanks!

ВeekeeCZ · ‎10-23-2015

This might help you with some...
http://www.cadstudio.cz/en/apps/suresave/

hmsilva · ‎10-23-2015

@jens.tornblad wrote:

Hi!

We have a certain process at our workplace where we have a working folder and a folder where we save the most recent version of the file without xrefs. We also have an old folder where the previous version of the drawing in the recent folder is moved to.

Is it possible to automate this proccess with a script?

What we need is:

All xrefs detached

UCS world

Save a copy of the drawing with the same name to the "recent" folder and also move the (if) existing file to "old" with the same name but _YYMMDD at the end.

Keep the "working" drawing open in Autocad

Ultimately this would all be achieved with a keyboard shortcut.

Is this possible?

Thanks!

Hello jens.tornblad and welcome to the Autodesk Community!

yes, it is possible.

Quick and dirty...
Change the 'old' and 'recent' paths, to the correct ones...

(defun c:demo (/ *error* adoc dwg)
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))

    (defun *error* (msg)
        (vla-endundomark adoc)
        (cond
            ((not msg))
            ((member msg '("Function cancelled" "quit / exit abort")))
            ((princ (strcat "\n** Error: " msg " ** ")))
        )
        (if command-s
            (command-s "_.undo" "")
            (command "_.undo" "")
        )
        (princ)
    )

    (vla-startundomark adoc)
    (command "_.-xref" "_D" "*")
    (command "_.qsave")
    (command "_.ucs" "_W")
    (setq dwg (substr (getvar 'dwgname) 1 (- (strlen (getvar 'dwgname)) 4)))
    (if (findfile (strcat "c:/Test/recent/" (getvar 'dwgname)))
        (if (findfile (strcat "c:/Test/old/" dwg "_" (menucmd "M=$(edtime,$(getvar,date),YYMD)") ".dwg"))
            (progn
                (vl-file-delete (strcat "c:/Test/old/" dwg "_" (menucmd "M=$(edtime,$(getvar,date),YYMD)") ".dwg"))
                (vl-file-copy
                    (strcat "c:/Test/recent/" (getvar 'dwgname))
                    (strcat "c:/Test/old/" dwg "_" (menucmd "M=$(edtime,$(getvar,date),YYMD)") ".dwg")
                )
                (vl-file-delete (strcat "c:/Test/recent/" (getvar 'dwgname)))
                (vl-file-copy
                    (strcat (getvar 'dwgprefix) (getvar 'dwgname))
                    (strcat "c:/Test/recent/" (getvar 'dwgname))
                )
            )
            (progn
                (vl-file-copy
                    (strcat "c:/Test/recent/" (getvar 'dwgname))
                    (strcat "c:/Test/old/" dwg "_" (menucmd "M=$(edtime,$(getvar,date),YYMD)") ".dwg")
                )
                (vl-file-delete (strcat "c:/Test/recent/" (getvar 'dwgname)))
                (vl-file-copy
                    (strcat (getvar 'dwgprefix) (getvar 'dwgname))
                    (strcat "c:/Test/recent/" (getvar 'dwgname))
                )
            )
        )
        (vl-file-copy
            (strcat (getvar 'dwgprefix) (getvar 'dwgname))
            (strcat "c:/Test/recent/" (getvar 'dwgname))
        )
    )
    (*error* nil)
    (princ)
)

Hope this helps,
Henrique

jens.tornblad · ‎10-26-2015

Wow! This is great! Real timesaver! A couple of questions regarding a couple of changes I thought of when I tried it out.
Is it possible to also purge the file? I tried adding

(command "_.-purge" "_A" "*" "_N")

after

    (vla-startundomark adoc)
    (command "_.-xref" "_D" "*")
    (command "_.qsave")
    (command "_.ucs" "_W")

without any luck. It purges the file but then the script appears to stop. I only want the "recent" file to get purged.

Also another change, if possible. I don't want the script to overwrite the old file if there's already one with the same date. In other words if an old file is already created for the day I don't want to overwrite that if the script is run again on that day.

Thank you very much for the help.

hmsilva · ‎10-26-2015

@jens.tornblad wrote:

Wow! This is great! Real timesaver! A couple of questions regarding a couple of changes I thought of when I tried it out.
Is it possible to also purge the file? I tried adding
(command "_.-purge" "_A" "*" "_N")
after
    (vla-startundomark adoc)
    (command "_.-xref" "_D" "*")
    (command "_.qsave")
    (command "_.ucs" "_W")
without any luck. It purges the file but then the script appears to stop. I only want the "recent" file to get purged.

Also another change, if possible. I don't want the script to overwrite the old file if there's already one with the same date. In other words if an old file is already created for the day I don't want to overwrite that if the script is run again on that day.

Thank you very much for the help.

You're welcome, jens.tornblad!
The

(command "_.-purge" "_A" "*" "_N")

should not stop the code,

(defun c:demo (/ *error* adoc dwg dwg_old)
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))

    (defun *error* (msg)
        (vla-endundomark adoc)
        (cond
            ((not msg))
            ((member msg '("Function cancelled" "quit / exit abort")))
            ((princ (strcat "\n** Error: " msg " ** ")))
        )
        (if command-s
            (command-s "_.undo" "")
            (command "_.undo" "")
        )
        (princ)
    )

    (setq dwg (substr (getvar 'dwgname) 1 (- (strlen (getvar 'dwgname)) 4)))
    (setq dwg_old (strcat "c:/Test/old/" dwg "_" (menucmd "M=$(edtime,$(getvar,date),YYMD)") ".dwg"))
    (cond ((not (findfile dwg_old))
           (vla-startundomark adoc)
           (command "_.-xref" "_D" "*")
           (command "_.qsave")
           (command "_.ucs" "_W")
           (command "_.-purge" "_A" "*" "_N")

           (if (findfile (strcat "c:/Test/recent/" (getvar 'dwgname)))
               (progn
                   (vl-file-copy
                       (strcat "c:/Test/recent/" (getvar 'dwgname))
                       (strcat "c:/Test/old/" dwg "_" (menucmd "M=$(edtime,$(getvar,date),YYMD)") ".dwg")
                   )
                   (vl-file-delete (strcat "c:/Test/recent/" (getvar 'dwgname)))
                   (vl-file-copy
                       (strcat (getvar 'dwgprefix) (getvar 'dwgname))
                       (strcat "c:/Test/recent/" (getvar 'dwgname))
                   )
               )

               (vl-file-copy
                   (strcat (getvar 'dwgprefix) (getvar 'dwgname))
                   (strcat "c:/Test/recent/" (getvar 'dwgname))
               )
           )
           (*error* nil)
          )
          (T
           (princ "\nA backup has already been created today... ")
          )
    )
    (princ)
)

Untested, I don't have AutoCAD in this laptop...

Hope this helps,
Henrique

Henrique

jens.tornblad · ‎10-26-2015

@hmsilva wrote:

@jens.tornblad wrote:
Wow! This is great! Real timesaver! A couple of questions regarding a couple of changes I thought of when I tried it out.
Is it possible to also purge the file? I tried adding
(command "_.-purge" "_A" "*" "_N")
after
    (vla-startundomark adoc)
    (command "_.-xref" "_D" "*")
    (command "_.qsave")
    (command "_.ucs" "_W")
without any luck. It purges the file but then the script appears to stop. I only want the "recent" file to get purged.

Also another change, if possible. I don't want the script to overwrite the old file if there's already one with the same date. In other words if an old file is already created for the day I don't want to overwrite that if the script is run again on that day.

Thank you very much for the help.

You're welcome, jens.tornblad!
The

(command "_.-purge" "_A" "*" "_N")

should not stop the code,

(defun c:demo (/ *error* adoc dwg dwg_old)
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))

    (defun *error* (msg)
        (vla-endundomark adoc)
        (cond
            ((not msg))
            ((member msg '("Function cancelled" "quit / exit abort")))
            ((princ (strcat "\n** Error: " msg " ** ")))
        )
        (if command-s
            (command-s "_.undo" "")
            (command "_.undo" "")
        )
        (princ)
    )

    (setq dwg (substr (getvar 'dwgname) 1 (- (strlen (getvar 'dwgname)) 4)))
    (setq dwg_old (strcat "c:/Test/old/" dwg "_" (menucmd "M=$(edtime,$(getvar,date),YYMD)") ".dwg"))
    (cond ((not (findfile dwg_old))
           (vla-startundomark adoc)
           (command "_.-xref" "_D" "*")
           (command "_.qsave")
           (command "_.ucs" "_W")
           (command "_.-purge" "_A" "*" "_N")

           (if (findfile (strcat "c:/Test/recent/" (getvar 'dwgname)))
               (progn
                   (vl-file-copy
                       (strcat "c:/Test/recent/" (getvar 'dwgname))
                       (strcat "c:/Test/old/" dwg "_" (menucmd "M=$(edtime,$(getvar,date),YYMD)") ".dwg")
                   )
                   (vl-file-delete (strcat "c:/Test/recent/" (getvar 'dwgname)))
                   (vl-file-copy
                       (strcat (getvar 'dwgprefix) (getvar 'dwgname))
                       (strcat "c:/Test/recent/" (getvar 'dwgname))
                   )
               )

               (vl-file-copy
                   (strcat (getvar 'dwgprefix) (getvar 'dwgname))
                   (strcat "c:/Test/recent/" (getvar 'dwgname))
               )
           )
           (*error* nil)
          )
          (T
           (princ "\nA backup has already been created today... ")
          )
    )
    (princ)
)

Untested, I don't have AutoCAD in this laptop...

Hope this helps,
Henrique

Henrique

Thanks again! Kudos for superfast reply!

Purge doesn't seem to work, I can see that it runs purge but when i open the "recent" file all excess layers and such still seem to be there.

I also noticed that the working file is saved without xrefs, is it possible to change the order so detaching is done after qsave?

Lastly, with the new version the script doesn't run at all if there is already an old file. Maybe I explained unclear before, but I would like the script to still run, just skip the step where the recent file is moved to old. In other words, I want everything to proceed as before just not overwrite the "old" file.

Thanks again, amazing work!

hmsilva · ‎10-26-2015

Once again, untested...

(defun c:demo (/ *error* adoc dwg)
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))

    (defun *error* (msg)
        (vla-endundomark adoc)
        (cond
            ((not msg))
            ((member msg '("Function cancelled" "quit / exit abort")))
            ((princ (strcat "\n** Error: " msg " ** ")))
        )
        (if command-s
            (command-s "_.undo" "")
            (command "_.undo" "")
        )
        (if command-s
            (command-s "_.qsave")
            (command "_.qsave")
        )
        (princ)
    )

    (vla-startundomark adoc)
    (command "_.-xref" "_D" "*")
    (command "_.qsave")
    (command "_.ucs" "_W")
    (repeat 3 (command "_.-purge" "_A" "*" "_N"))
    (setq dwg (substr (getvar 'dwgname) 1 (- (strlen (getvar 'dwgname)) 4)))
    (if (findfile (strcat "c:/Test/recent/" (getvar 'dwgname)))
        (if (findfile (strcat "c:/Test/old/" dwg "_" (menucmd "M=$(edtime,$(getvar,date),YYMD)") ".dwg"))
            (progn
                ;|(vl-file-delete (strcat "c:/Test/old/" dwg "_" (menucmd "M=$(edtime,$(getvar,date),YYMD)") ".dwg"))
                (vl-file-copy
                    (strcat "c:/Test/recent/" (getvar 'dwgname))
                    (strcat "c:/Test/old/" dwg "_" (menucmd "M=$(edtime,$(getvar,date),YYMD)") ".dwg")
                )|;
                (vl-file-delete (strcat "c:/Test/recent/" (getvar 'dwgname)))
                (vl-file-copy
                    (strcat (getvar 'dwgprefix) (getvar 'dwgname))
                    (strcat "c:/Test/recent/" (getvar 'dwgname))
                )
            )
            (progn
                (vl-file-copy
                    (strcat "c:/Test/recent/" (getvar 'dwgname))
                    (strcat "c:/Test/old/" dwg "_" (menucmd "M=$(edtime,$(getvar,date),YYMD)") ".dwg")
                )
                (vl-file-delete (strcat "c:/Test/recent/" (getvar 'dwgname)))
                (vl-file-copy
                    (strcat (getvar 'dwgprefix) (getvar 'dwgname))
                    (strcat "c:/Test/recent/" (getvar 'dwgname))
                )
            )
        )
        (vl-file-copy
            (strcat (getvar 'dwgprefix) (getvar 'dwgname))
            (strcat "c:/Test/recent/" (getvar 'dwgname))
        )
    )
    (*error* nil)
    (princ)
)

Hope this helps,
Henrique

jens.tornblad · ‎10-29-2015

Thank you very much for this! Like I said, really a timesaver and I just tested it on our real files and it works great. The only thing that I still can't get to work is purge. When I open the created file there are still a lot of stuff that gets deleted when I run purge manually. Should I just give up on purge and delete that line from the script?

Everything else works great. You just saved med tons of time since I had to do this manually before.

hmsilva · ‎10-29-2015

@jens.tornblad wrote:

Thank you very much for this! Like I said, really a timesaver and I just tested it on our real files and it works great. The only thing that I still can't get to work is purge. When I open the created file there are still a lot of stuff that gets deleted when I run purge manually. Should I just give up on purge and delete that line from the script?

Everything else works great. You just saved med tons of time since I had to do this manually before.

You're welcome, jens.tornblad
Try to change the 'qsave' position in the code

(vla-startundomark adoc)
(command "_.-xref" "_D" "*")
 ;(command "_.qsave") from here
(command "_.ucs" "_W")
(repeat 3 (command "_.-purge" "_A" "*" "_N"))
(command "_.qsave") ;<= to here

Hope this helps,
Henrique

jens.tornblad · ‎01-26-2016

Hi again!
I was going through some backup files yesterday and noticed that the date format is not exactly as I wanted.
For example todays date, 2016-01-26 gets written as 16126. This is a bit confusing since for example 2016-10-11 gets written as 161011 and 2016-01-01 as 1611.

I looked through the script and found that the reason is probably that the code says YYMD. What I really want is YYMMDD so that 2016-01-01 is written as 160101. I tried to change the code to YYMMDD but that resulted in todays date 2016-01-26 being written as 161426. Which is not what I want. I don't even understand where it got the "4" from.

Is it possible to fix this so that numbers <10 gets a 0 in front of them? This would be much appreciated as it would create consitency in the file order.

hmsilva · ‎01-26-2016

Try

(menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD)")

Hope this helps,
Henrique

Anonymous · ‎01-26-2016

Try changing

 (menucmd "M=$(edtime,$(getvar,date),YYMD)")

to

(menucmd "M=$(edtime,$(getvar,date),YY/MO/DD)")

jens.tornblad · ‎02-03-2016

Thanks to both of you, I changed every code that contained YYMD to YYMODD and it seems to have done the trick!

hmsilva · ‎02-03-2016

@jens.tornblad wrote:

Thanks to both of you, I changed every code that contained YYMD to YYMODD and it seems to have done the trick!

You're welcome, Jens!
Glad you got a solution!

Henrique