;Rename file with current date addition in the end of file
;with close current drawing, delete it and open renamed file in a one click (via wblock) .. modified by Igal Averbuh 2015
;Based on Kerry Brown program. See topic:
http://www.theswamp.org/index.php?topic=50551.msg556774#msg556774

(defun c:tpz (/ *error*) ; TODO add local variables

;===============================================================
(defun TODAY ( / d yr mo day)
(setq d (rtos (getvar "CDATE") 2 6)
yr (substr d 3 2)
mo (substr d 5 2)
day (substr d 7 2)
);setq
(strcat day "-" mo "-" yr)
);defun
;;;*-----------------------------------------------------------
(defun TIME ( / d hr m s)
(setq d (rtos (getvar "CDATE") 2 6)
hr (substr d 10 2)
m (substr d 12 2)
s (substr d 14 2)
);setq
(strcat hr "-" m "-" s)
);defun
;;;*------------------------------------------------------------

;;-----------

(defun *error* (msg) (myDefault*error* msg))

;;-----------

(vl-cmdf "_qsave")

(setq dwgprefix (getvar "dwgprefix")

dwgname (getvar "dwgname")

filename-base (vl-filename-base dwgname)

tempprefix (getvar "tempprefix")

thedate (today)

)

(setq OriginalFileName (strcat dwgprefix dwgname)

ArchiveFileName (strcat tempprefix

dwgname

"-"

(rtos (* (getvar "cdate") 1000000) 2 0)

)

newFileName (strcat dwgprefix

filename-base

"-TPZ-" thedate

".Dwg"

)

)

;;--

(setq expert (getvar "expert"))

(setvar "expert" 5)

;;---------- wblock

(vl-cmdf "-layer" "set" "0" "")

(vl-cmdf ".ucs" "W")

;(vl-cmdf "Zoom" "E") ;optional

;(vl-cmdf "_Saveas" "2013" ArchiveFileName) ;optional

(setq ss (ssget "X"))

(vl-cmdf ".wblock" newFileName "" (getvar "insbase") ss "")

(setvar "expert" expert)

;;---------- write script

(setq fn (open (strcat tempprefix "sclean.scr") "w"))

(write-line "close n" fn)

(write-line

(strcat "open "

(strcat (vl-string-right-trim

"\""

(vl-prin1-to-string

(vl-string-translate "\\" "/" newFileName)

)

)

"\""

)

)

fn

)

(write-line

(strcat

"(vl-file-delete "

(vl-string-right-trim

"\""

(vl-prin1-to-string (vl-string-translate "\\" "/" dwgprefix))

)

filename-base

".dwg\")"

)

fn

)

(close fn)

;;----------

(vl-cmdf "script" (strcat tempprefix "sclean.scr"))

(princ)

)

(princ)

(defun myDefault*error* (msg)

(while (< 0 (getvar 'cmdactive)) (command-s nil))

(setvar 'menuecho 1)

(cond ((not msg))

((member

(strcase msg t)

'("console break" "function cancelled" "quit / exit abort")

)

(princ "\nFunction Cancelled.")

)

((princ (strcat "\nApplication Error: "

(itoa (getvar 'errno))

" :- "

msg

)

)

(vl-bt)

)

)

(setvar 'errno 0)

(princ)

)

(princ)

(c:tpz)

Advertisements