Save a dwg in a subfolder with the same name as the file, using lisp code

[Anonymous]

Hello,

I am a total noob with lisp and I'm using a very useful lisp code I found  on a forum somewhere (very slightly modified), that saves the dwg file with a date and time stamp.

Can someone help me so that the date and time appears before the file's name?

 For example I'd like the file to read "test 09-09-16_12.22'28.dwg''" instead of "09-09-16_12.22'28'' test.dwg"

And more importantly, can each file be saved in a subfolder automatically created, that has the same name as the file? So if the file is named

"test.dwg", a subfolder will be created and named "test" as well, automatically without any input from the user, containing all the saved files.

Thank you in advance.

This is the code I'm using:

;; TED KRUSH 9/23/02

;;; Routine that was created @ Southern Maine Technical College.
;;; Saves Drawing an eariler version and then resaves as
;;; orginal version to maitain defualt save.

;; UPDATED 02/02/03 Added Date Sub-Routine
;; UPDATED 03/11/05 Revise version save 2002/R14 to 2004/2000 per upgrade to Autocad 2005 version
;; UPDATED 04/05/06 Adde StrPath Sub-Rountine, so as new file can be saved to folder.

;;;; *** Now We go to to Commerical Break for the Typical Legal Mumbo Jumbo ***
;;;; Permission to use, copy, modify, and distribute this software
;;;; for any purpose and without fee is hereby granted.
;;;;
;;;; I PROVIDE THIS PROGRAM "AS IS" AND WITH ALL FAULTS. I SPECIFICALLY DISCLAIM ANY
;;;; IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. I DO NOT
;;;; WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE UNINTERRUPTED OR ERROR FREE.

(defun c:scon ()

;;Error Trap utilizing the TedError Function
(command ".undo" "m")
(setq old_error *error*)
(setq *error* tederror)

;;Start of Date defun~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun TODAY (/ d yr mo day hr m s) ;define the function and declare all variabled local

(setq d (rtos (getvar "CDATE") 2 6)
;get the date and time and convert to text

yr (substr d 3 2) ;extract the year
mo (substr d 5 2) ;extract the month
day (substr d 7 2) ;extract the day
hr (substr d 10 2) ;extract the hour
m (substr d 12 2) ;extract the minute
s (substr d 14 2) ;extract the second
)

(setq dates (strcat mo "-" day "-" yr "_" hr "." m "'" s"'' ")) ;string 'em together
(princ)
)
;;End of Date defun

;;Start of StrPath defun~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun StrPath ()
(setq OldName (getvar "dwgname"))
;; Extracts the Drawing File Name
(setq OldPath (getvar "dwgprefix"))
;; Extracts the Drawing Location
(setq NewPath (vl-string-subst
"\\Transfer-Outgoing\\"
"\\Drawings\\"
OldPath
)
)

(setq OldFile (strcat OldPath OldName))
; Text String for Old File
(setq NewFile (strcat NewPath dates Oldname))
; Text String for New File
(princ)
)
;;End of StrPath defun

;; Main Rountine
(today)
(StrPath)

(vl-mkdir NewPath)

(setvar "expert" 4)
(command "saveas" "2004" NewFile) ;New file with date Prefix
(command "saveas" "2004" OldFile) ;Saves back to the Orginal File.
(setvar "expert" 0)
(setq *error* old_error)
(princ)
)

[Anonymous]

I incorporated the code to create a subfolder with the same name as the dwg file. Now I just need

the newly saved dwg with the time stamp,  to be moved into that folder. Can someone help me please?

The code so far:

;; TED KRUSH 9/23/02

;;; Routine that was created @ Southern Maine Technical College.
;;; Saves Drawing an eariler version and then resaves as
;;; orginal version to maitain defualt save.

;; UPDATED 02/02/03 Added Date Sub-Routine
;; UPDATED 03/11/05 Revise version save 2002/R14 to 2004/2000 per upgrade to Autocad 2005 version
;; UPDATED 04/05/06 Adde StrPath Sub-Rountine, so as new file can be saved to folder.

;;;; *** Now We go to to Commerical Break for the Typical Legal Mumbo Jumbo ***
;;;; Permission to use, copy, modify, and distribute this software
;;;; for any purpose and without fee is hereby granted.
;;;;
;;;; I PROVIDE THIS PROGRAM "AS IS" AND WITH ALL FAULTS. I SPECIFICALLY DISCLAIM ANY
;;;; IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. I DO NOT
;;;; WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE UNINTERRUPTED OR ERROR FREE.

(defun c:scon ()

(vl-mkdir (vl-filename-base (getvar "dwgname")))

;;Error Trap utilizing the TedError Function
(command ".undo" "m")
(setq old_error *error*)
(setq *error* tederror)

;;Start of Date defun~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun TODAY (/ d yr mo day hr m s) ;define the function and declare all variabled local

(setq d (rtos (getvar "CDATE") 2 6)
;get the date and time and convert to text

yr (substr d 3 2) ;extract the year
mo (substr d 5 2) ;extract the month
day (substr d 7 2) ;extract the day
hr (substr d 10 2) ;extract the hour
m (substr d 12 2) ;extract the minute
s (substr d 14 2) ;extract the second
)

(setq dates (strcat mo "-" day "-" yr "_" hr "." m "'" s"'' ")) ;string 'em together
(princ)
)
;;End of Date defun

;;Start of StrPath defun~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun StrPath ()
(setq OldName (getvar "dwgname"))
;; Extracts the Drawing File Name
(setq OldPath (getvar "dwgprefix"))
;; Extracts the Drawing Location
(setq NewPath (vl-string-subst
"\\Transfer-Outgoing\\"
"\\Drawings\\"
OldPath
)
)

(setq OldFile (strcat OldPath OldName))
; Text String for Old File
(setq NewFile (strcat NewPath dates Oldname))
; Text String for New File
(princ)
)
;;End of StrPath defun

;; Main Rountine
(today)
(StrPath)

(vl-mkdir NewPath)

(setvar "expert" 4)
(command "saveas" "2004" NewFile) ;New file with date Prefix
(command "saveas" "2004" OldFile) ;Saves back to the Orginal File.
(setvar "expert" 0)
(setq *error* old_error)
(princ)

)