Универсальный загрузчик кодов
Текста много, принципиально нового и страшного ничего нет. Это всем известно и все подобным пользуются. Как всегда - текст тупо шпаргалка для себя.
Собственно задача звучит так: необходимо разработать лисп-код, который:
а) загружает arx / dbx модули - из своих каталогов, с учетом разрядности и версии
б) загружает .NET-сборки. Тоже из своих каталогов, тоже с учетом версии (с возможным учетом разрядности).
в) загружает все lsp, fas, vlx из указанных каталогов
г) загружает все VBA-модули (как бы лично я к ним ни относился, но все еще пользуется спросом-то...)
Лиспы не зря поставил не первым - там могут использоваться функции и команды, прописанные в arx / net.
Как бы ни хотелось, но сначала надо определиться, где и как хранить те же каталоги и исключения, а заодно и с правилами именования каталогов разобраться.
Мне кажется, что идеальным вариантом для хранения подобных данных будет реестр. Следовательно, надо проверить наличие соответствующих данных, а при их отсутствии - запросить.
Но прежде всего - определить, в каком месте реестра будет все храниться. Думается, что лучше все же в реестре организовывать собственный подраздел в HKCU\Software, ну и плюс добавить версию, локализацию ACAD - и имя используемого профиля. Конечно, можно использовать переменные окружения AutoCAD (это которые получаются через getenv - но я предпочитаю полностью контролировать, что и где хранится).
Вернемся все же к собственному узлу в реестре и его имени. Чтобы не вычислять это дело по тысяче раз, загоним во внедокументную переменную:
Получение ключа реестра
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
| (setq reg_key"RegisterHive")
(if (not (cdr (assoc reg_key(vl-bb-ref '*kpblc-settings*))))
(progn
(vl-bb-set '*kpblc-settings*
(cons (cons reg_key
(strcat "HKEY_CURRENT_USER\\Software\\kpblc\\"
(vl-registry-read (strcat "HKEY_LOCAL_MACHINE\\" (vlax-product-key)) "ProductNameGlob")
"x"
(if (and (getvar "platform") (wcmatch (strcase (getvar "platform")) "*X64*"))
"64"
"32"
) ;_ end of if
":"
(vl-registry-read (strcat "HKEY_LOCAL_MACHINE\\" (vlax-product-key)) "LocaleID")
"\\"
(getvar "cprofile")
) ;_ end of strcat
) ;_ end of cons
(vl-bb-ref '*kpblc-settings*)
) ;_ end of cons
) ;_ end of vl-bb-set
) ;_ end of progn
) ;_ end of if |
Ок, оно у нас есть. При первом запуске там пусто, конечно. В принципе есть два варианта: либо написать лисп, который будет запрашивать соответствующие каталоги, либо вообще создать отдельное приложение (да хоть на C#). На шарпах, конечно, будет очень красиво - но придется предварительно приложение запускать, да и разрабатывать его "вотпрямщас" лениво. Проще уж воспользоваться имеющимися решениями, создав минимально необходимое окно dcl (ну, присоединим несколько дополнительных функций, не страшно).
В принципе, этот кусочек имеет смысл вообще как отдельную функцию/команду сделать - просто для того, чтобы иметь возможность без залезания в реестр подправить каталоги. И чего тянуть кота за хвост? Делаем функцию, в которую параметром будем просто передавать имя узла реестра и необходимость принудительного вывода диалога:
Получение и задание путей загрузки
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
| (defun get-all-datas (reg-key ask / dcl_id dcl_lst dcl_res handle)
;|
* Возвращает каталоги исходников
* Параметры вызова:
reg-key ; имя узла реестра, откуда считывать данные. nil недопустим
ask ; независимо от того, есть или нет данные, выводится диалог
* Примеры вызова:
(get-all-datas "HKEY_CURRENT_USER\\Software\\kpblc\\AutoCAD 2018x64:409\\<<Unnamed profile>>" nil)
(get-all-datas "HKEY_CURRENT_USER\\Software\\kpblc\\AutoCAD 2018x64:409\\<<Unnamed profile>>" t)
|;
(defun fun_browsefolder (caption / shlobj folder fldobj outval)
;|
http://www.autocad.ru/cgi-bin/f1/board.cgi?t=21054YY
* Без отображения файлов
* Параметры вызова:
caption показываемый заголовок (пояснение) окна
(setq Folder (vlax-invoke-method ShlObj 'BrowseForFolder 0 "" 16384))
|; (setq shlobj (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application")
folder (vlax-invoke-method
shlobj
'browseforfolder
(vla-get-hwnd (vlax-get-acad-object))
caption
(+ 512 16)
) ;_ end of vlax-invoke-method
) ;_ end of setq
(vlax-release-object shlobj)
(if folder
(progn (setq fldobj (vlax-get-property folder 'self)
outval (vlax-get-property fldobj 'path)
) ;_ end of setq
(vlax-release-object folder)
(vlax-release-object fldobj)
) ;_ end of progn
) ;_ end of if
outval
) ;_ end of defun
(defun _kpblc-list-add-or-subst (lst key value)
(if (not value)
(vl-remove-if (function (lambda (x) (= (car x) key))) lst)
(if (cdr (assoc key lst))
(subst (cons key value) (assoc key lst) lst)
(cons (cons key value) (vl-remove-if (function (lambda (x) (= (car x) key))) lst))
) ;_ end of if
) ;_ end of if
) ;_ end of defun
(defun fun_paths_callback (key value ref-list / temp)
(cond ((= key "btn_arx")
(if (and (setq temp (fun_browsefolder "Родительский каталог arx")) (/= temp ""))
(progn (set_tile "txt_arx" temp)
(set ref-list (_kpblc-list-add-or-subst (eval ref-list) "arx" temp))
) ;_ end of progn
) ;_ end of if
)
((= key "txt_arx") (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "arx" value)))
((= key "btn_vba")
(if (and (setq temp (fun_browsefolder "Родительский каталог vba")) (/= temp ""))
(progn (set_tile "txt_vba" temp)
(set ref-list (_kpblc-list-add-or-subst (eval ref-list) "vba" temp))
) ;_ end of progn
) ;_ end of if
)
((= key "txt_arx") (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "arx" value)))
((= key "btn_net")
(if (and (setq temp (fun_browsefolder "Родительский каталог .net")) (/= temp ""))
(progn (set_tile "txt_net" temp)
(set ref-list (_kpblc-list-add-or-subst (eval ref-list) "net" temp))
) ;_ end of progn
) ;_ end of if
)
((= key "txt_net") (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "net" value)))
((= key "btn_lsp")
(if (and (setq temp (fun_browsefolder "Родительский каталог arlspx")) (/= temp ""))
(progn (set_tile "txt_lsp" temp)
(set ref-list (_kpblc-list-add-or-subst (eval ref-list) "lsp" temp))
) ;_ end of progn
) ;_ end of if
)
((= key "txt_lsp") (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "lsp" value)))
) ;_ end of cond
) ;_ end of defun
(setq dcl_lst (mapcar (function (lambda (key) (cons key (vl-registry-read reg-key key))))
(vl-registry-descendents reg-key "")
) ;_ end of mapcar
) ;_ end of setq
(if (or (not dcl_lst) ask)
(progn (setq dcl_file (strcat (vl-string-right-trim "\\" (getenv "TEMP")) "\\dlg.dcl")
handle (open dcl_file "w")
) ;_ end of setq
(foreach item '("dlg:dialog{label=\"Каталоги исходников\";"
" :row{label=\"ARX с версиями и разрядностями\";children_fixed_width=true;"
" :edit_box{key=\"txt_arx\";width=60;}" " :button{key=\"btn_arx\";width=3;label=\"...\";}"
" }"
" :row{label=\"NET с версиями [и разрядностями]\";children_fixed_width=true;"
" :edit_box{key=\"txt_net\";width=60;}" " :button{key=\"btn_net\";width=3;label=\"...\";}"
" }" " :row{label=\"VBA\";children_fixed_width=true;"
" :edit_box{key=\"txt_vba\";width=60;}" " :button{key=\"btn_vba\";width=3;label=\"...\";}"
" }" " :row{label=\"LSP, VLX, FAS\";children_fixed_width=true;"
" :edit_box{key=\"txt_lsp\";width=60;}" " :button{key=\"btn_lsp\";width=3;label=\"...\";}"
" }" " ok_cancel;"
" }"
)
(write-line item handle)
) ;_ end of foreach
(close handle)
(setq dcl_id (load_dialog dcl_file))
(new_dialog "dlg" dcl_id "(fun_paths_callback $key $value 'dcl_lst)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(foreach item dcl_lst
(set_tile (strcat "txt_" (car item))
(cond ((cdr item))
(t "")
) ;_ end of cond
) ;_ end of set_tile
(fun_paths_callback (strcat "txt_" (car item)) (cdr item) 'dcl_lst)
) ;_ end of foreach
(setq dcl_res (start_dialog))
(unload_dialog dcl_id)
(if (= dcl_res 1)
(progn (foreach item dcl_lst
(if (= (vl-string-trim " " (cdr item)) "")
(vl-registry-delete reg-key (car item))
(vl-registry-write reg-key (car item) (cdr item))
) ;_ end of if
) ;_ end of foreach
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
(mapcar (function (lambda (x) (cons x (vl-registry-read reg-key x))))
(vl-registry-descendents reg-key "")
) ;_ end of mapcar
) ;_ end of defun |
Оформлять как команду будем чуть позже, в общем коде.
А теперь уже можно и загрузку выполнять, отфильтровав нужные версии для arx / dbx / net / vba. Считаем, что:
- arx / dbx модули не свалены в один каталог, а распределены по подкаталогам <Версия ACAD>x<Разрядность> (\2018x32, \2018x64, \2019x32, \2019x64 и т.п.).
- net модули распределены по подкаталогам <Версия ACAD> либо <Версия ACAD>x<Разрядность> (\2018, \2018x64 и т.п.)
- lsp / fas / vlx просто раскиданы по подкаталогам с любой структурой
- vba - без распределения по версиям ACAD'a
Собственно загрузка
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
| (defun load-all-codes (key-path-list / _kpblc-browsefiles-in-directory-nested bit ver_nobit ver_bit path sysvar err err_lst)
;|
* Собственно загрузка исходников (ну и не только их)
* Параметры вызова:
key-path-list ; список как результат вызова get-all-datas
* Примеры вызова:
(load-all-codes (get-all-datas "HKEY_CURRENT_USER\\Software\\kpblc\\AutoCAD 2018x64:409\\<<Unnamed profile>>" nil))
|;
(defun _kpblc-browsefiles-in-directory-nested (path mask)
;|
* Функция возвращает список файлов указанной маски, находящихся в
* заданном каталоге
* Параметры вызова:
path ; путь к корневому каталогу. nil недопустим
mask ; маска имени файла. nil или список недопустим
* Примеры вызова:
(_kpblc-browsefiles-in-directory-nested "c:\\documents" "*.dwg")
|; (apply (function append)
(cons (if (vl-directory-files path mask 1)
(mapcar (function (lambda (x) (strcat (vl-string-right-trim "\\" path) "\\" x)))
(vl-directory-files path mask 1)
) ;_ end of mapcar
) ;_ end of if
(mapcar (function
(lambda (x)
(_kpblc-browsefiles-in-directory-nested (strcat (vl-string-right-trim "\\" path) "\\" x) mask)
) ;_ end of lambda
) ;_ end of function
(vl-remove ".." (vl-remove "." (vl-directory-files path nil -1)))
) ;_ end of mapcar
) ;_ end of cons
) ;_ end of apply
) ;_ end of defun
(setq ver_nobit (itoa (atoi (vl-string-trim "VISUALP " (strcase (ver)))))
bit (strcat "x"
(if (and (getvar "platform") (wcmatch (strcase (getvar "platform")) "*X64*"))
"64"
"32"
) ;_ end of if
) ;_ end of strcat
ver_bit (strcat ver_nobit bit)
sysvar (vl-remove nil
(mapcar (function (lambda (item / temp)
(if (setq temp (getvar (car item)))
(progn (setvar (car item) (cdr item)) (cons (car item) temp))
) ;_ end of if
) ;_ end of lambda
) ;_ end of function
) ;_ end of mapcar
'(("secureload" . 0) ("cmdecho" . 0) ("menuecho" . 0) ("nomutt" . 1))
) ;_ end of vl-remove
) ;_ end of setq
(foreach item (mapcar (function (lambda (x) (cons (strcase (car x) t) (vl-string-right-trim "\\ " (cdr x)))))
key-path-list
) ;_ end of mapcar
(cond ((= (car item) "arx")
;; Версия + разрядность
(if (setq path (car (vl-sort (vl-remove-if
(function (lambda (x) (or (member x '("." "..")) (> (atoi x) (atoi ver_nobit)))))
(vl-directory-files (cdr item) (strcat "*" bit ".*") -1)
) ;_ end of vl-remove-if
(function (lambda (a b) (> (atoi a) (atoi b))))
) ;_ end of vl-sort
) ;_ end of car
) ;_ end of setq
(progn (setq path (strcat (cdr item) "\\" path))
(foreach file (mapcar (function (lambda (x) (strcat path "\\" x))) (vl-directory-files path "*.*" 1))
(if (vl-catch-all-error-p (setq err (vl-catch-all-error-p (function (lambda () (arxload file))))))
(setq err_lst (cons (cons file (vl-catch-all-error-message err)) err_lst))
) ;_ end of if
) ;_ end of foreach
) ;_ end of progn
) ;_ end of if
)
((= (car item) "net")
(if (setq path (car (vl-sort (vl-remove-if
(function (lambda (x) (or (member x '("." "..")) (> (atoi x) (atoi ver_nobit)))))
(vl-directory-files (cdr item) (strcat "*" bit ".*") -1)
) ;_ end of vl-remove-if
(function (lambda (a b) (> (atoi a) (atoi b))))
) ;_ end of vl-sort
) ;_ end of car
) ;_ end of setq
(progn (setq path (strcat (cdr item) "\\" path))
(foreach file (mapcar (function (lambda (x) (strcat path "\\" x))) (vl-directory-files path "*.*" 1))
(if (vl-catch-all-error-p
(setq err (vl-catch-all-apply (function (lambda () (vl-cmdf "_.netload" file)))))
) ;_ end of vl-catch-all-error-p
(setq err_lst (cons (cons file (vl-catch-all-error-message err)) err_lst))
) ;_ end of if
) ;_ end of foreach
) ;_ end of progn
) ;_ end of if
(if (setq path (car (vl-sort (vl-remove-if
(function (lambda (x) (or (not (wcmatch x "####")) (> (atoi x) (atoi ver_nobit)))))
(vl-directory-files (cdr item) "*" -1)
) ;_ end of vl-remove-if
(function (lambda (a b) (> (atoi a) (atoi b))))
) ;_ end of vl-sort
) ;_ end of car
) ;_ end of setq
(progn (setq path (strcat (cdr item) "\\" path))
(foreach file (mapcar (function (lambda (x) (strcat path "\\" x))) (vl-directory-files path "*.*" 1))
(if (vl-catch-all-error-p
(setq err (vl-catch-all-apply (function (lambda () (vl-cmdf "_.netload" file)))))
) ;_ end of vl-catch-all-error-p
(setq err_lst (cons (cons file (vl-catch-all-error-message err)) err_lst))
) ;_ end of if
) ;_ end of foreach
) ;_ end of progn
) ;_ end of if
)
((= (car item) "vba")
(foreach file (mapcar (function (lambda (x) (strcat (cdr item) "\\" x))) (vl-directory-files (cdr item) "*.dvb"))
(if (vl-catch-all-error-p (setq err (vl-catch-all-apply (function (lambda () (vl-vbaload file))))))
(setq err_lst (cons (cons file (vl-catch-all-error-message err)) err_lst))
) ;_ end of if
) ;_ end of foreach
)
((= (car item) "lsp")
(foreach file (vl-remove-if-not
(function (lambda (x) (member (strcase (vl-filename-extension x)) '(".LSP" ".FAS" ".VLX"))))
(_kpblc-browsefiles-in-directory-nested (cdr item) "*.*")
) ;_ end of vl-remove-if-not
(if (vl-catch-all-error-p (setq err (vl-catch-all-apply (function (lambda () (load file))))))
(setq err_lst (cons (cons file (vl-catch-all-error-message err)) err_lst))
) ;_ end of if
) ;_ end of foreach
)
) ;_ end of cond
) ;_ end of foreach
(foreach item sysvar (setvar (car item) (cdr item)))
(if err_lst
(princ (strcat "\nОшибки загрузки : "
(apply (function strcat)
(mapcar (function (lambda (x) (strcat "\n" (car x) " : " (cdr x)))) err_lst)
) ;_ end of apply
) ;_ end of strcat
) ;_ end of princ
) ;_ end of if
) ;_ end of defun |
Остались мелочи - все объединить в один lsp, создать команду настройки путей - и все.
Результат лежит тут:
load-all-codes.lsp
Как вариант - можно скачать, установить в автозагрузку, добавить самовызов... В общем, вариантов масса
Похожее
