make a copy of current open drawing & place it into a predetermine folder

[Lee Mac]

Try the following instead:

(defun c:dwgbackup ( / dir dst dwg src )
   
   (setq dir "C:\\MyBackupFolder" ;; Backup Folder
         dir (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir))
         dwg (getvar 'dwgname)
   )
   (cond
       (   (zerop (getvar 'dwgtitled))
           (princ "\nCurrent drawing is unsaved.")
       )
       (   (not (or (vl-file-directory-p dir) (vl-mkdir dir)))
           (princ (strcat "\nUnable to create the directory \"" dir "\"."))
       )
       (   (LM:fsocopyfile
               (setq src (strcat (getvar 'dwgprefix) dwg))
               (setq dst (LM:uniquefilename (strcat dir "\\" dwg)))
           )
       )
       (   (princ (strcat "\nUnable to copy \"" src "\" to \"" dst "\".")))
   )
   (princ)
)

;; FSO Copy File  -  Lee Mac
;; Leverages the CopyFile method of the FileSystemObject to copy a file
;; src - [str] Filepath of file to be copied
;; dst - [str] Destination file or folder

(defun LM:fsocopyfile ( src dst / fso rtn )
   (if (and (setq src (findfile src))
            (setq fso (vlax-create-object "scripting.filesystemobject"))
       )
       (progn
           (setq rtn (vl-catch-all-apply 'vlax-invoke (list fso 'copyfile src dst :vlax-false)))
           (vlax-release-object fso)
           (not (vl-catch-all-error-p rtn))
       )
   )
)

;; Unique Filename  -  Lee Mac
;; Returns a filename suffixed with the smallest integer required for uniqueness

(defun LM:uniquefilename ( fnm )
   (if (findfile fnm)
       (apply
          '(lambda ( pth bse ext / tmp )
               (setq tmp 1)
               (while (findfile (setq fnm (strcat pth bse "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
           )
           (fnsplitl fnm)
       )
   )
   fnm
)

(vl-load-com) (princ)

 

Edited November 17, 2018 by Lee Mac

[tive29]

Thanks Lee Mac. :) It works. Tested at home only so try in office (main drawing & xref on sever drives, backup will be on c:drive) in a few days later, hope no hiccups.

 

Try the following instead:

([color=BLUE]defun[/color] c:dwgbackup ( [color=BLUE]/[/color] dir dst dwg src )
   
   ([color=BLUE]setq[/color] dir [color=MAROON]"C:\\MyBackupFolder"[/color] [color=GREEN];; Backup Folder[/color]
         dir ([color=BLUE]vl-string-right-trim[/color] [color=MAROON]"\\"[/color] ([color=BLUE]vl-string-translate[/color] [color=MAROON]"/"[/color] [color=MAROON]"\\"[/color] dir))
         dwg ([color=BLUE]getvar[/color] 'dwgname)
   )
   ([color=BLUE]cond[/color]
       (   ([color=BLUE]zerop[/color] ([color=BLUE]getvar[/color] 'dwgtitled))
           ([color=BLUE]princ[/color] [color=MAROON]"\nCurrent drawing is unsaved."[/color])
       )
       (   ([color=BLUE]not[/color] ([color=BLUE]or[/color] ([color=BLUE]vl-file-directory-p[/color] dir) ([color=BLUE]vl-mkdir[/color] dir)))
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nUnable to create the directory \""[/color] dir [color=MAROON]"\"."[/color]))
       )
       (   (LM:fsocopyfile
               ([color=BLUE]setq[/color] src ([color=BLUE]strcat[/color] ([color=BLUE]getvar[/color] 'dwgprefix) dwg))
               ([color=BLUE]setq[/color] dst (LM:uniquefilename ([color=BLUE]strcat[/color] dir [color=MAROON]"\\"[/color] dwg)))
           )
       )
       (   ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nUnable to copy \""[/color] src [color=MAROON]"\" to \""[/color] dst [color=MAROON]"\"."[/color])))
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; FSO Copy File  -  Lee Mac[/color]
[color=GREEN];; Leverages the CopyFile method of the FileSystemObject to copy a file[/color]
[color=GREEN];; src - [str] Filepath of file to be copied[/color]
[color=GREEN];; dst - [str] Destination file or folder[/color]

([color=BLUE]defun[/color] LM:fsocopyfile ( src dst [color=BLUE]/[/color] fso rtn )
   ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]setq[/color] src ([color=BLUE]findfile[/color] src))
            ([color=BLUE]setq[/color] fso ([color=BLUE]vlax-create-object[/color] [color=MAROON]"scripting.filesystemobject"[/color]))
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] rtn ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-invoke[/color] ([color=BLUE]list[/color] fso 'copyfile src dst [color=BLUE]:vlax-false[/color])))
           ([color=BLUE]vlax-release-object[/color] fso)
           ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] rtn))
       )
   )
)

[color=GREEN];; Unique Filename  -  Lee Mac[/color]
[color=GREEN];; Returns a filename suffixed with the smallest integer required for uniqueness[/color]

([color=BLUE]defun[/color] LM:uniquefilename ( fnm )
   ([color=BLUE]if[/color] ([color=BLUE]findfile[/color] fnm)
       ([color=BLUE]apply[/color]
          '([color=BLUE]lambda[/color] ( pth bse ext [color=BLUE]/[/color] tmp )
               ([color=BLUE]setq[/color] tmp 1)
               ([color=BLUE]while[/color] ([color=BLUE]findfile[/color] ([color=BLUE]setq[/color] fnm ([color=BLUE]strcat[/color] pth bse [color=MAROON]"("[/color] ([color=BLUE]itoa[/color] ([color=BLUE]setq[/color] tmp ([color=BLUE]1+[/color] tmp))) [color=MAROON]")"[/color] ext))))
           )
           ([color=BLUE]fnsplitl[/color] fnm)
       )
   )
   fnm
)

([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Edited April 30, 2017 by tive29

[BIGAL]

Thanks Lee for code but we need to copy a dwg file and a complete directory which holds 3rd party data attached to the dwg. Will give it a try and post here, it may be something useful as you may want to copy say an excel as well. I used "Shell copy \dir1\dwg \dir2\dwg" which works as well, is this simpler than vl-filecopy or do you think it will have problems.

[asos2000]

I am wondering, Could this lisp run with closing the file?