@mviscettoVGK6V wrote:
Hello,
Are you having success with your Lisp routine?
I am struggling with a couple users losing work. Not saving as they should.
And, as much as I am working on correcting the bad habits, I really would like to eliminate the "Lost Work" issue.
Thank you
MV
I know this is an old topic, but I've took some time to code for a solution for this very important issue...
(defun c:autosave-reactor-ON nil
(or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))
(if (not *autosave-reactor*)
(setq *autosave-reactor*
(vlr-command-reactor "autosave"
'(
(:vlr-commandended . autosave)
(:vlr-commandcancelled . autosave)
(:vlr-commandfailed . autosave)
)
)
)
)
(defun _nextchr ( character reverseflag / a ) ;;; character - either integer representing (ascii chr), or string representing character - (= (strlen character) 1)
(if (eq (type (setq a character)) 'str)
(setq a (ascii a))
)
(cond
( (< 47 a 58)
(cond
( (= a 57)
(if reverseflag 56 65)
)
( (= a 48)
(if reverseflag 122 49)
)
)
)
( (< 64 a 123)
(cond
( (= a 122)
(if reverseflag 121 48)
)
( (= a 65)
(if reverseflag 57 66)
)
)
)
)
(setq a (if reverseflag (1- a) (1+ a)))
(if (eq (type character) 'str)
(chr a)
a
)
)
(defun _incrementstring ( string reverseflag / _process _process_increment l a )
(defun _process ( l reverseflag / a ) ;;; l = reverse list of ascii string characters
(if l
(cond
( (= 122 (setq a (car l)))
(if reverseflag (cons 121 (cdr l)) (cdr l))
)
( (= 48 a)
(if reverseflag (cdr l) (cons 49 (cdr l)))
)
( t
(cons (_nextchr a reverseflag) (cdr l))
)
)
)
)
(defun _process_increment ( l reverseflag / a ) ;;; l = reverse list of ascii string characters
(if (setq a (_process l reverseflag))
(if (= (length a) (length l))
a
(cons (if reverseflag 122 48) (_process_increment a reverseflag))
)
)
)
(if (/= (length (setq a (_process_increment (reverse (vl-string->list string)) reverseflag))) (strlen string))
(setq l (if reverseflag (cons 122 a) (cons 48 a)))
(setq l a)
)
(vl-list->string (reverse l))
)
(defun autosave ( obj arg / olddwgname name newdwgname fn ct lwt lat )
(if
(and
(not (wcmatch (car arg) "U,UNDO,ZOOM,PAN"))
(zerop (rem (setq *autosave-count* (1+ *autosave-count*)) *autosave-setting*)) ;;; Change #50 to change the number of commands performed between saves.
(= 1 (getvar 'dwgtitled))
(or
(= 1 (logand 1 (getvar 'dbmod)))
(= 32 (logand 32 (getvar 'dbmod)))
)
)
(progn
(setq olddwgname (strcat (getvar 'dwgprefix) (getvar 'dwgname)))
(setq name (vl-filename-base (getvar 'dwgname)))
(while (findfile (setq newdwgname (strcat (getvar 'dwgprefix) name "_" (setq *autosave-suffix* (if *autosave-suffix* (_incrementstring *autosave-suffix* nil) (_incrementstring *suffix* nil))) ".dwg")))) ;;; reverseflag = nil (NO REVERSE LAST CHAR FOR INCREMENTATION)
(vla-saveas *autosave-acdoc* newdwgname)
(vl-file-copy olddwgname (strcat name "_tmp.dwg"))
(vla-saveas *autosave-acdoc* olddwgname)
(if (and (not *flg*) (setq *flg* (findfile (strcat name ".bak"))))
(vl-file-rename (strcat name ".bak") (strcat name "_old.dwg"))
)
(vl-file-copy (strcat name "_tmp.dwg") olddwgname)
(vl-file-delete (strcat name "_tmp.dwg"))
)
)
(princ)
)
(setq *autosave-acdoc* (vla-get-activedocument (vlax-get-acad-object)) ;;; current dwg file
*autosave-count* 0 ;;; command counter start point
)
(initget 6)
(setq *autosave-setting*
(cond
( (getint "\nSpecify autosaving reactor reaction after < 30 > processed commands without - U,UNDO,ZOOM,PAN (input integer number) : ") )
( 30 )
)
)
(or *suffix* (/= (setq *suffix* (getstring "\nSpecify suffix to be added at the end of autosave files after _ <\"00000000\"> : ")) "") (setq *suffix* "00000000"))
(princ)
)
(defun c:autosave-reactor-OFF nil
(or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))
(if *autosave-reactor*
(vlr-remove *autosave-reactor*)
)
(mapcar (function (lambda ( x ) (set x nil))) '(*autosave-acdoc* *autosave-count* *autosave-setting* *autosave-suffix* *suffix* *flg* *autosave-reactor* _nextchr _incrementstring autosave))
(princ)
)HTH. M.R.
Regards...
Marko Ribar, d.i.a. (graduated engineer of architecture)
