-
Notifications
You must be signed in to change notification settings - Fork 1
/
archive-on-save.lsp
358 lines (336 loc) · 14 KB
/
archive-on-save.lsp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
; =============================================================================
; MIT License
;
; Copyright (c) 2021 Brian C.
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.
; =============================================================================
;
; Archive on save
; https://github.com/thelegendofbrian/C3D-Utils
;
; Description:
; Augments _QSAVE functionality to create an archived version of the file prior to saving.
; Tested on Civil 3D 2020.
; Author: Brian C.
;
; Behavior:
; On save, searches for the most recently archived version of the current drawing, saved as
; ./Archive/VOID_<file-name>_YYYY-MM-DD_hh-mm-ss.<file-extension>, relevative to the directory the
; file is saved in. If the most recent archive, as determined by filename, not file properties, is
; older than +archive-threshhold+ days, the file is archived into the ./Archive/ folder with a
; filename containing the time of archival, not the file's last modification property. If the file is
; newly created, defined as having been edited less than +archive-edit-threshhold+ days and created
; less than +archive-threshhold+ days ago, the file will not be archived.
;
; Configurable values:
; +archive-threshhold+ : [default = 1 day] number of days old a file needs to be to get
; auto-archived (can be fractional)
; +archive-edit-threshhold+ : [default = 2 hours] number of days old a file must be opened for
; to get auto-archived (can be fractional)
;
; TODO: Add error handling
; TODO: Convert archive function to command for use outside of saving
; TODO: Add "C3DU:" prefix on function names to avoid conflicts
; TODO: Consider making +archive-threshhold+ and +archive-edit-threshhold+ global
; Load extensions
(load (findfile "julian.lsp"))
(vl-load-com)
(command "undefine" "_QSAVE")
;
; Externally sourced function declarations
;
; rtos wrapper - Lee Mac
; A wrapper for the rtos function to negate the effect of DIMZIN
; http://www.lee-mac.com/consistentrtos.html
(defun LM:rtos (real units prec / dimzin result)
(setq dimzin (getvar 'dimzin))
(setvar 'dimzin 0)
(setq result (vl-catch-all-apply 'rtos (list real units prec)))
(setvar 'dimzin dimzin)
(if (not (vl-catch-all-error-p result))
result
)
)
;
; Function declarations
;
; Return date as list of strings '(YYYY MM DD hh mm ss)
(defun get-date-string (/ date-string YYYY MM DD H M S)
(setq date-string (LM:rtos (getvar "cdate") 2 6))
(setq YYYY (substr date-string 1 4)
MM (substr date-string 5 2)
DD (substr date-string 7 2)
H (substr date-string 10 2)
M (substr date-string 12 2)
S (substr date-string 14 2)
)
(strcat YYYY "-" MM "-" DD "_" H "-" M "-" S)
)
; Archive specified file in ./Archive/ relative to parent
(defun arch-dwg (file-dir file-name file-ext / arch-dir arch-prefix new-arch-path)
(setq arch-dir (strcat file-dir "Archive\\"))
; Create Archive directory if needed
(if (not (vl-file-directory-p arch-dir))
(vl-mkdir arch-dir)
)
(setq arch-prefix (strcat "VOID_" file-name "_"))
(setq new-arch-path (strcat arch-dir arch-prefix (get-date-string) "." file-ext))
(vl-file-copy (strcat file-dir file-name "." file-ext) new-arch-path)
)
; Find date of most recent "version 1" named archive of specified file
; The "version 1" naming convension is defined as "VOID-*-YYYY-MM-DD.*" with an optional "(1)" after the days
; More specifcally, with regex: VOID-.*-\d{4}\-\d{2}\-\d{2}[(1)]*\.[^.]*$
(defun get-last-v1-arch-date (file-dir file-name file-ext / arch-dir arch-prefix
arch-list most-recent-arch most-recent-arch-date
)
(setq arch-dir (strcat file-dir "Archive\\"))
(setq arch-prefix (strcat "VOID-" file-name "-"))
; Create a list of all v1 archives for the specified file
(setq arch-list (vl-directory-files arch-dir
(strcat arch-prefix "????-??-??." file-ext)
1
)
)
; If list was empty, no archives exist
(if arch-list
(progn
; Find most recent archive in list
; Variants with a "(1)" prefix can be ignored because those were previously only created when a non-"(1)" variant existed for a date
(setq most-recent-arch (car (vl-sort arch-list '>)))
(setq most-recent-arch-date (substr most-recent-arch
(- (strlen most-recent-arch)
(+ 10 (strlen file-ext))
)
10
)
)
; Convert date string "YYYY-MM-DD" to format 20210417.1037 = 2020/04/17 10:37AM
; Assumes midnight as time since not specified in this naming convention
(setq most-recent-arch-date (strcat (substr most-recent-arch-date 1 4)
(substr most-recent-arch-date 6 2)
(substr most-recent-arch-date 9 2)
)
)
)
(setq most-recent-arch-date nil)
)
)
; Find date of most recent "version 2" named archive of specified file
; The "version 2" naming convension is defined as "VOID_*_YYYY-MM-DD_hh_mm_ss.*"
; More specifcally, with regex: VOID_.*_\d{4}\-\d{2}\-\d{2}_\d{2}-\d{2}-\d{2}\.[^.]*$
(defun get-last-v2-arch-date (file-dir file-name file-ext / arch-dir arch-prefix
arch-list most-recent-arch most-recent-arch-date
)
(setq arch-dir (strcat file-dir "Archive\\"))
(setq arch-prefix (strcat "VOID_" file-name "_"))
; Create a list of all v1 archives for the specified file
(setq arch-list (vl-directory-files arch-dir
(strcat arch-prefix
"????-??-??_??-??-??."
file-ext
)
1
)
)
; If list was empty, no archives exist
(if arch-list
(progn
; Find most recent archive in list
(setq most-recent-arch (car (vl-sort arch-list '>)))
(setq most-recent-arch-date (substr most-recent-arch
(- (strlen most-recent-arch)
(+ 19 (strlen file-ext))
)
19
)
)
; Convert date string "YYYY-MM-DD_hh_mm_ss" to format 20210417.103702 = 2020/04/17 10:37:02AM
(setq most-recent-arch-date (strcat (substr most-recent-arch-date 1 4)
(substr most-recent-arch-date 6 2)
(substr most-recent-arch-date 9 2)
"."
(substr most-recent-arch-date 12 2)
(substr most-recent-arch-date 15 2)
(substr most-recent-arch-date 18 2)
)
)
)
(setq most-recent-arch-date nil)
)
)
; Find date of most recent archive of specified file
; Returns date in format: 20210417.1037 = 2020/04/17 10:37AM
(defun get-last-arch-date (file-dir file-name file-ext / last-v1-arch-date
last-v2-arch-date last-arch-date
)
(setq last-v1-arch-date (get-last-v1-arch-date file-dir file-name file-ext))
(setq last-v2-arch-date (get-last-v2-arch-date file-dir file-name file-ext))
; Return most recent of the two
(if (> last-v1-arch-date last-v2-arch-date)
(setq last-arch-date last-v1-arch-date)
(setq last-arch-date last-v2-arch-date)
)
; Check if archive was found
(if (not last-arch-date)
(setq last-arch-date nil)
(setq last-arch-date (distof last-arch-date))
)
)
; Finds difference between two dates in days
; Expected date format: 20210417.1037 = 2020/04/17 10:37AM
(defun day-diff (date1 date2)
(- (dtoj date1) (dtoj date2))
)
(defun get-days-since-arch (file-dir file-name file-ext / last-arch-date)
(setq last-arch-date (get-last-arch-date file-dir file-name file-ext))
(if (not last-arch-date)
(setq last-arch-date 19700101)
(day-diff
(getvar 'cdate)
last-arch-date
)
)
)
;
; Command declaration
;
(defun C:QSAVE (/ cmdecho-initial +archive-threshhold+ +fifty-years+
+archive-edit-threshhold+ file-dir file-name-full file-name-full-len
start-of-ext file-name file-ext days-since-arch
)
(setq cmdecho-initial (getvar "cmdecho"))
(setvar "cmdecho" 0)
(initdia 1)
(setq +archive-threshhold+ 1) ; number of days old a file needs to be to get auto-archived (can be fractional)
(setq +archive-edit-threshhold+ 0.0833) ; number of days old a file must be opened for to get auto-archived (can be fractional)
(setq +fifty-years+ 18250) ; number of days in 50 years. Treats >50 year old archive as non-existent
; Check if drawing is saved anywhere
(if (= (getvar "dwgtitled") 1)
(progn
(setq file-dir (getvar "dwgprefix")) ; H:\\12345-Project\\
(setq file-name-full (getvar "dwgname")) ; 12345-MSTR.dwg
; Separate filename from extension
(setq file-name-full-len (strlen file-name-full))
(setq start-of-ext (vl-string-position (ascii ".") file-name-full nil t))
(setq file-name (substr file-name-full 1 start-of-ext)) ; 12345-MSTR
(setq file-ext (substr file-name-full (+ start-of-ext 2))) ; dwg
(setq days-since-arch (get-days-since-arch file-dir file-name file-ext))
; Print easily readable days-since-arch
(cond
((> days-since-arch +fifty-years+)
(princ "\nDrawing has never been archived.")
)
((> days-since-arch 365)
(princ
(strcat "\nDrawing last archived "
(LM:rtos days-since-arch 2 1)
" year(s) ago."
)
)
)
((> days-since-arch 30)
(princ
(strcat "\nDrawing last archived "
(LM:rtos (/ days-since-arch 30) 2 1)
" month(s) ago."
)
)
)
((> days-since-arch 2)
(princ
(strcat "\nDrawing last archived "
(LM:rtos days-since-arch 2 1)
" days(s) ago."
)
)
)
((> days-since-arch 0.08333)
(princ
(strcat "\nDrawing last archived "
(LM:rtos (* 24 days-since-arch) 2 1)
" hours(s) ago."
)
)
)
((> days-since-arch 0.000694)
(princ
(strcat "\nDrawing last archived "
(LM:rtos (* 1440 days-since-arch) 2 1)
" minutes(s) ago."
)
)
)
(t
(princ (strcat "\nDrawing last archived less than a minute ago."))
)
)
(if (> days-since-arch +archive-threshhold+)
(progn
(if
(and (> days-since-arch +fifty-years+)
(< (getvar "TDINDWG") +archive-edit-threshhold+)
(> +archive-threshhold+
(day-diff (getvar "date") (getvar "tdcreate"))
)
)
(princ "\nDrawing is too new to warrant automatic archival.\n")
(progn
(princ "\nAutomatically archiving drawing prior to saving.\n")
(arch-dwg file-dir file-name file-ext)
; TODO: Add error handling
)
)
)
(princ "\nA recent archive exists for this drawing.\n")
)
)
(princ "\nThis drawing is new and cannot be archived prior to saving.\n")
)
(command ".QSAVE")
(setvar "cmdecho" cmdecho-initial)
(princ)
)
(defun C:ARCHIVEDRAWING (/ cmdecho-initial file-dir file-name-full file-name-full-len start-of-ext
file-name file-ext
)
(setq cmdecho-initial (getvar "cmdecho"))
(setvar "cmdecho" 0)
(initdia 1)
; Check if drawing is saved anywhere
(if (= (getvar "dwgtitled") 1)
(progn
(setq file-dir (getvar "dwgprefix")) ; H:\\12345-Project\\
(setq file-name-full (getvar "dwgname")) ; 12345-MSTR.dwg
; Separate filename from extension
(setq file-name-full-len (strlen file-name-full))
(setq start-of-ext (vl-string-position (ascii ".") file-name-full nil t))
(setq file-name (substr file-name-full 1 start-of-ext)) ; 12345-MSTR
(setq file-ext (substr file-name-full (+ start-of-ext 2))) ; dwg
(arch-dwg file-dir file-name file-ext)
(setvar "cmdecho" cmdecho-initial)
)
(progn
(alert "This drawing is unsaved and cannot be archived prior to saving.")
(princ "\nThis drawing is unsaved and cannot be archived prior to saving.\n")
)
)
(princ)
)
(princ)