AutoLISP routine to save CAD files with date revision number and timestamp

Hi guys,

Wondering if this is possible or not, to
1. save a CAD file with the Filename - Date - Rev00- Timestamp,
2. when it saved it should be saved in two locations, one being the working directory from which the drawing was opened and then in a folder called superseded
3. each time it is saved the date - rev - timestamp change (note the rev number needs to be incremented by 1)
4. the previous version of the file in the working directory to be deleted completely

I have a vba macro which does this for excel spreadsheets
BaberA62Asked:
Who is Participating?
 
NVITCommented:
Done.

; Save a CAD file with the name: Filename-Date-Timestamp.dwg
; Saves in two locations:
;  a. The directory where the active drawing was opened.
;  b. A sub-folder named "Superseded", e.g. Superseded\Filename-Date-Timestamp.dwg
; Each save:
;  a. Overwrites the previous version of the active drawing.
;  b. Copies the active drawing to the Superseded folder

(defun c:SAV ( / xx nChkForDirs nChkForFiles cFNCurrVer cFNOld cFFNOld cPadZero cSubd cSubdFN cSupersedeDir lcFNCur lcFNCurPfx oFNIsTimeNamed nVarEXPERT nMaxDateStrLen)
	; BEGIN debug
	(setvar "cmdecho" 1)
	; END debug

  (setq
		cSubd "superseded"
		cFNOld (getvar "dwgname")
		;cFFNOld (strcat (getvar "dwgprefix") cFNOld)
		nMaxDateStrLen 15
		nChkForDirs -1 
		nChkForFiles 1
		cFNDelim "-"
	)
  (setq nVarEXPERT (getvar "expert"))
	(setvar "expert" 5)
	; If current name is already "dwgname-Date-Timestamp.dwg"...
	; then make new name with current date & time
	; else just suffix date & time to dwgname
  (setq 
		lcFNCur (cdr (reverse (parse cFNOld ".")))
		lcFNCur (parse (car lcFNCur) cFNDelim)
		lcFNCurPfx (car lcFNCur)
		lcFNCur (reverse (LM:sublst (reverse lcFNCur) 0 2))
	)
  (if (AllNIL (mapcar '(lambda (c) (zerop (atoi c))) lcFNCur))
    (setq
			oFNIsTimeNamed t
			cFNCurPfx lcFNCurPfx
		)
		(setq cFNCurPfx (car lcFNCur))
	)

  ; Make the Filename
  (setq 
    cFNCurrVer (strcat cFNCurPfx cFNDelim (STRREPL (STD-STRING-RIGHT-PAD-CHAR (rtos (getvar "CDATE") 2 6) nMaxDateStrLen "0") "." cFNDelim))
    cSubdFN (strcat (getvar "dwgprefix") cSubd "\\" cFNCurrVer ".dwg")
  )

  ; Save the dwg and copy it.
  (prompt "\nSaving...")
  (command ".saveas" "" cFNCurrVer)
	(if (not (vl-file-delete (strcat (getvar "dwgprefix") cFNOld)))
    (prompt (strcat "\nError deleting " cFNOld)))
  (MkSubDir (strcat (getvar "dwgprefix") cSubd))
  (prompt (strcat "\nCopying to " cSubdFN))
  (if (not (vl-file-copy (strcat (getvar "dwgprefix") (getvar "dwgname")) cSubdFN))
    (prompt (strcat "\nError copying " cSubdFN)))
  (setvar "expert" nVarEXPERT)
  (princ)
)

; Utility functions
(defun AllNil (Lst)
  (eval
    (cons 'and
      (mapcar 'null
        (mapcar 'eval Lst)))))

(defun LM:sublst ( lst idx len / rtn )
    (setq len (if len (min len (- (length lst) idx)) (- (length lst) idx))
          idx (+  idx len)
    )
    (repeat len (setq rtn (cons (nth (setq idx (1- idx)) lst) rtn)))
)
(defun STD-STRING-RIGHT-PAD-CHAR (s n char)
  (while (< (strlen s) n) (setq s (strcat s char)))
  s
)

(defun STRREPL (SRC SRCH SREP / TMP)
  (setq TMP (STRFIND SRC SRCH))
  (if (not (null (cadr TMP)))
    (strcat (car TMP) SREP (cadr TMP)) SRC)
)

(defun STRFIND (SRC SRCH / CNT RET)
  (setq CNT 1)
  (while (<= CNT (strlen SRC))
    (if
      (= (substr SRC CNT (strlen SRCH)) SRCH)
        (setq
          RET (list
                (substr SRC 1 (1- CNT))
                (substr SRC (+ CNT (strlen SRCH))))
          CNT (1+ (strlen SRC)))
        (setq CNT (1+ CNT))))
  (if (null RET) (list SRC nil) RET)
)

(defun parse (str delim / out pos)
   (setq delim (ascii delim))
   (while (setq pos (vl-string-position delim str))
   ;(if (> pos 0);not just adjacent delimiters
   (setq out (cons (substr str 1 pos) out))
   (setq str (substr str (+ 2 pos)))
   )
   (reverse (cons str out))
)

(defun MkSubDir (cDirName / cDir)
   (setq cDir (vl-directory-files "" cDirName -1))
   (if (not cDir)
      (progn
         (vl-mkdir cDirName)
         (vl-directory-files "" cDirName -1)))
)

Open in new window

0
 
NVITCommented:
You can either:
- If you want to totally replace the default SAVE command, make a command to replace it and do what you want.
- Make a new command, e.g. SAVE2 and do what you want.
0
 
BaberA62Author Commented:
Ok the question is how do I go about doing this?

I'm not familiar with programming in AutoLISP (or any LISP language for that matter).
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
NVITCommented:
I can whip something up. But, adding the REV* option to the filename complicates things.

Would having it without REV* suffice, e.g. a filename like test_20150305.095812.dwg. Notice that it contains the filename_date.time.dwg. This is similar to your REV* need with each "revision" by date instead of REV0001, REV0002, ...

With this solution you can sort the filename by date and time.

I guess it depends on how quick you need it.
0
 
BaberA62Author Commented:
That sound great ... I await in anticipation ...
0
 
NVITCommented:
- Save code to e.g. SAV.LSP file in same folder as the .dwg, or in the folder where your other .lsp files are.

; 1. Save a CAD file with the name: Filename_Date.Timestamp.dwg
; 2. Saves in two locations:
;  a. The directory where the active drawing was opened, e.g. ThisDrawing.dwg
;  b. A sub-folder of the active named "Superseded", e.g. Superseded\ThisDrawing-Date.Timestamp.dwg
; 3. Each save:
;  a. Overwrites the previous version of the active drawing.
;  b. Copies the active drawing to a new Superseded\ThisDrawing.Date-Timestamp.dwg

;************************
; This version does Filename-Date.Timestamp
;************************
(defun c:SAV ( / nChkForDirs nChkForFiles cFNCurrVer cPadZero cSubd cSubdFN cSrcFN cSupersedeDir nVarEXPERT nMaxDateStrLen)
   (setq cSubd "superseded")
   (setq cSrcFN (strcat (getvar "dwgprefix") (getvar "dwgname")))
   (setq nMaxDateStrLen 15)
   (setq nVarEXPERT (getvar "expert"))
   (setvar "expert" 5)
   ; vl-directory-files options
   (setq nChkForDirs -1 nChkForFiles 1)

   ; Make the Filename
   (setq 
      cFNCurrVer (strcat (car (parse (getvar "dwgname") ".")) "-" (STD-STRING-RIGHT-PAD-CHAR (rtos (getvar "CDATE") 2 6) nMaxDateStrLen "0"))
      cSubdFN (strcat (getvar "dwgprefix") cSubd "\\" cFNCurrVer ".dwg")
   )

   ; Save the dwg and copy it.
   (prompt "\nSaving...")
   (command ".save" "")

   ; Make the subdir
   (MkSubDir cSubd)
   (prompt (strcat "\nCopying to " cSubdFN))
   (if (not (vl-file-copy cSrcFN cSubdFN))
      (prompt (strcat "\nError copying " cSubdFN)))
   (setvar "expert" nVarEXPERT)
   (princ)
)

; Utility functions
(defun STD-STRING-RIGHT-PAD-CHAR (s n char)
  (while (< (strlen s) n) (setq s (strcat s char)))
  ;;(substr s 1 n)
  s
)

(defun MkSubDir (cDirName / cDir)
   (setq cDir (vl-directory-files "" cDirName -1))
   (if (not cDir)
      (progn
         (vl-mkdir (strcat ".\\" cDirName))
         (vl-directory-files "" cDirName -1)))
)

(defun parse (str delim / out pos)
   (setq delim (ascii delim))
   (while (setq pos (vl-string-position delim str))
   ;(if (> pos 0);not just adjacent delimiters
   (setq out (cons (substr str 1 pos) out))
   (setq str (substr str (+ 2 pos)))
   )
   ;(if (> (strlen str) 0);not a trailing delimiter
   (reverse (cons str out))
   ;(reverse out)
)

Open in new window


- To load in AutoCAD, type:
(load "SAV.LSP")

Open in new window


- To run it, type:
SAV

Open in new window

0
 
BaberA62Author Commented:
Hi NewVillageIT,

Below is the error message I'm getting:

Command: SAV
Saving....save Save drawing as <C:\Users\bbeg\Desktop\TEST\Drawing1.dwg>:
Command:
Copying to C:\Users\bbeg\Desktop\TEST\superseded\Drawing1-20150311.085654.dwg
Error copying C:\Users\bbeg\Desktop\TEST\superseded\Drawing1-20150311.085654.dwg

I think maybe if you could substitute a "-" rather than a "." between the date and time that might make a difference.
0
 
NVITCommented:
Hi...
So, it didn't make a copy to C:\Users\bbeg\Desktop\TEST\superseded?
Hmm...

Is the superseded folder there?
0
 
BaberA62Author Commented:
No there is no superseded folder there either. The routine seems to crash before it gets there.
0
 
NVITCommented:
I wasn't getting errors at my end. Still, I revised as follows.
Revision Notes:
- Replaced "." with "-" so filename looks more like original request.
- Revised MkSubDir call.
- Added support functions.

(defun c:SAV ( / nChkForDirs nChkForFiles cFNCurrVer cPadZero cSubd cSubdFN cSrcFN cSupersedeDir nVarEXPERT nMaxDateStrLen)
   (setq cSubd "superseded")
   (setq cSrcFN (strcat (getvar "dwgprefix") (getvar "dwgname")))
   (setq nMaxDateStrLen 15)
   (setq nVarEXPERT (getvar "expert"))
   (setvar "expert" 5)
   (setq nChkForDirs -1 nChkForFiles 1)

   ; Make the Filename
   (setq 
      cFNCurrVer (strcat (car (parse (getvar "dwgname") ".")) "-" (STRREPL (STD-STRING-RIGHT-PAD-CHAR (rtos (getvar "CDATE") 2 6) nMaxDateStrLen "0") "." "-"))
      cSubdFN (strcat (getvar "dwgprefix") cSubd "\\" cFNCurrVer ".dwg")
   )

   ; Save the dwg and copy it.
   (prompt "\nSaving...")
   (command ".save" "")

   ; Make the subdir
   (MkSubDir (strcat (getvar "dwgprefix") cSubd))
   (prompt (strcat "\nCopying to " cSubdFN))
   (if (not (vl-file-copy cSrcFN cSubdFN))
      (prompt (strcat "\nError copying " cSubdFN)))
   (setvar "expert" nVarEXPERT)
   (princ)
)

; Utility functions
(defun STD-STRING-RIGHT-PAD-CHAR (s n char)
  (while (< (strlen s) n) (setq s (strcat s char)))
  s
)

(defun STRREPL (SRC SRCH SREP / TMP)
  (setq TMP (STRFIND SRC SRCH))
  (if (not (null (cadr TMP)))
    (strcat (car TMP) SREP (cadr TMP)) SRC)
)

(defun STRFIND (SRC SRCH / CNT RET)
  (setq CNT 1)
  (while (<= CNT (strlen SRC))
    (if
      (= (substr SRC CNT (strlen SRCH)) SRCH)
        (setq
          RET (list
                (substr SRC 1 (1- CNT))
                (substr SRC (+ CNT (strlen SRCH))))
          CNT (1+ (strlen SRC)))
        (setq CNT (1+ CNT))))
  (if (null RET) (list SRC nil) RET)
)

(defun parse (str delim / out pos)
   (setq delim (ascii delim))
   (while (setq pos (vl-string-position delim str))
   (setq out (cons (substr str 1 pos) out))
   (setq str (substr str (+ 2 pos)))
   )
   (reverse (cons str out))
)

(defun MkSubDir (cDirName / cDir)
   (setq cDir (vl-directory-files "" cDirName -1))
   (if (not cDir)
      (progn
         (vl-mkdir cDirName)
         (vl-directory-files "" cDirName -1)))
)

Open in new window

0
 
BaberA62Author Commented:
Ok it kinda like works ... I have attached the screenshots.

It creates a superseded directory
It saves the files with timestamp etc in superseded directory each time command is run.

However, the directory one level up still has the original file first created.

I would like the directory one level up to have renamed the latest file to the same name as the latest one in the superseded directory.

At least we are moving forward.

Thanks for your assists so far appreciated.
2015-03-17-0844--test-directory.png
2015-03-17-0845.png
0
 
NVITCommented:
will work on it later. Swamped w/ real work... 8-)
0
 
Saqib Husain, SyedEngineerCommented:
Are you interested i a VBA solution too?
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.