(vl-load-com)
;; (GET-ALL-PLOTCONFIGS "D:\\Ошибки и заявки")
(defun _kpblc-odbx (/)
(cond ((< (atof (getvar "acadver")) 15.06)
(alert "ObjectDBX method not applicable\nin this AutoCAD version")
nil
)
((= (fix (atof (getvar "acadver"))) 15)
(if (not (vl-registry-read "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"))
(startapp "regsvr32.exe" (strcat "/s \"" (findfile "axdb15.dll") "\""))
) ;_ end of if
(vla-getinterfaceobject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
)
(t
(vla-getinterfaceobject
(vlax-get-acad-object)
(strcat "ObjectDBX.AxDbDocument." (itoa (atoi (getvar "acadver"))))
) ;_ end of vla-getinterfaceobject
)
) ;_ end of cond
) ;_ end of defun
(defun _kpblc-odbx-open (file odbx / res obj tmp_file)
;|
* Открытие любого файла, даже в режиме "ReadOnly"
* Параметры вызова:
file полное имя открываемого файла. Только строка, контроля не
выполняется
odbx ObjectDBX-интерфейс, созданный (_kpblc-odbx).
* Возвращает список вида:
'(("obj" . <vla-указатель на гарантированно открытый документ>)
("close" . t | nil) ; допускается ли закрытие файла
("save" . t | nil) ; допускается ли сохранение файла
("write" . t | nil) ; допускается ли запись в файл
("name" . <строка имени файла>))
* Пример вызова:
(_kpblc-odbx-open "c:\\file.dwg" (setq conn (_kpblc-odbx)))
|;
(cond ((not file)
(setq res (list (cons "obj" (vla-get-activedocument (vlax-get-acad-object)))
(cons "write" t)
(cons "name" (vla-get-fullname (vla-get-activedocument (vlax-get-acad-object))))
) ;_ end of list
) ;_ end of setq
)
((member (strcase file)
(mapcar (function (lambda (x) (strcase (vla-get-fullname x))))
(_kpblc-conv-vla-to-list (vla-get-documents (vlax-get-acad-object)))
) ;_ end of mapcar
) ;_ end of member
(setq res (list (cons "obj"
(car (vl-remove-if-not
'(lambda (x) (= (strcase (vla-get-fullname x)) (strcase file)))
(_kpblc-conv-vla-to-list (vla-get-documents (vlax-get-acad-object)))
) ;_ end of vl-remove-if-not
) ;_ end of car
) ;_ end of cons
(cons "write" t)
(cons "save" t)
(cons "name" file)
) ;_ end of list
) ;_ end of setq
)
((and (findfile file) (_kpblc-is-file-read-only file))
(vl-file-copy
file
(setq tmp_file (strcat (vl-filename-mktemp (strcat (vl-filename-base file) (vl-filename-extension file)))))
) ;_ end of vl-file-copy
(vla-open odbx tmp_file)
(setq res (list (cons "obj" odbx) (cons "close" t) (cons "save" nil) (cons "write" nil) (cons "name" file)))
)
((and (findfile file) (not (_kpblc-is-file-read-only file)))
(vla-open odbx file)
(setq res (list (cons "obj" odbx) (cons "close" t) (cons "save" t) (cons "write" t) (cons "name" file)))
)
) ;_ end of cond
res
) ;_ end of defun
(defun _kpblc-odbx-close (conn)
;|
* Закрытие файла, открытого ранее через _kpblc-odbx-*. С попыткой сохранения
* Параметры вызова:
conn соединение с ObjectDBX, созданное ранее через (_kpblc-odbx) либо список:
'(("conn" . <ObjectDBXConnection>) ; то же самое
("save" . t) ; сохранять или нет изменения
("file" . "c:\\temp\\tmp.dwg") ; имя, под которым сохранять. nil -> использовать текущее
)
|;
(if (and (= (type conn) 'list) (cdr (assoc "save" conn)))
(progn (vlax-invoke
(cond ((cdr (assoc "conn" conn)))
(t (cdr (assoc "obj" conn)))
) ;_ end of cond
'saveas
(cond ((cdr (assoc "file" conn))
(strcat (_kpblc-dir-path-and-splash
(vl-filename-directory
(cond ((cdr (assoc "file" conn)))
((cdr (assoc "name" conn)))
) ;_ end of cond
) ;_ end of vl-filename-directory
) ;_ end of _kpblc-dir-path-and-splash
(vl-filename-base
(cond ((cdr (assoc "file" conn)))
((cdr (assoc "name" conn)))
) ;_ end of cond
) ;_ end of vl-filename-base
".dwg"
) ;_ end of strcat
)
(t
(vla-get-name
(cond ((cdr (assoc "conn" conn)))
(t (cdr (assoc "obj" conn)))
) ;_ end of cond
) ;_ end of vla-get-name
)
) ;_ end of cond
) ;_ end of vlax-invoke
) ;_ end of progn
) ;_ end of if
(vl-catch-all-apply
'(lambda ()
(vlax-release-object
(if (= (type conn) 'list)
(cond ((cdr (assoc "conn" conn)))
(t (cdr (assoc "obj" conn)))
) ;_ end of cond
conn
) ;_ end of if
) ;_ end of vlax-release-object
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
(setq conn nil)
) ;_ end of defun
(defun _kpblc-conv-vla-to-list (value / res) ;|
* Преобразовывает vlax-variant или vlax-safearray в список.
|;
(cond ((listp value) (mapcar (function _kpblc-conv-vla-to-list) value))
((= (type value) 'variant) (_kpblc-conv-vla-to-list (vlax-variant-value value)))
((= (type value) 'safearray)
(if (>= (vlax-safearray-get-u-bound value 1) 0)
(_kpblc-conv-vla-to-list (vlax-safearray->list value))
) ;_ end of if
)
((and (= (type value) 'vla-object) (vlax-property-available-p value 'count))
(vlax-for sub value (setq res (cons sub res)))
)
(t value)
) ;_ end of cond
) ;_ end of defun
(defun _kpblc-is-file-read-only (file-name / file_hangle res)
;|
* Проверяет, является ли файл "read-only". Возвращает t, если да. Проверки
* наличия файла не выполняется.
* Параметры вызова:
* file-name полное имя файла, с путем.
(_kpblc-is-file-read-only "Z:\\КТО transit\\Разное\\Устройство молниезащиты.dwg")
|;
(and file-name
(findfile file-name)
(or (not (vl-file-systime file-name))
((lambda (/ svr obj res)
(setq svr (vlax-get-or-create-object "Scripting.FileSystemObject")
obj (vlax-invoke-method svr 'getfile file-name)
res (vlax-get-property obj 'attributes)
) ;_ end of setq
(vlax-release-object obj)
(vlax-release-object svr)
(setq obj nil
svr nil
) ;_ end of setq
(/= (* 2 (/ res 2)) res)
) ;_ end of lambda
)
) ;_ end of or
) ;_ end of and
) ;_ end of defun
(defun _kpblc-dir-path-and-splash (path)
;|
* Возвращает путь со слешем в конце
* Параметры вызова:
* path - обрабатываемый путь
* Примеры вызова:
(_kpblc-dir-path-and-splash "c:\\kpblc-cad") ; "c:\\kpblc-cad\\"
|;
(strcat (vl-string-right-trim "\\" path) "\\")
) ;_ end of defun
(defun _kpblc-browsefiles-in-directory-nested (path mask)
;|
* Функция возвращает список файлов указанной маски, находящихся в
* заданном каталоге
* Параметры вызова:
path путь к корневому каталогу. nil недопустим
mask маска имени файла. nil или список недопустим
* Примеры вызова:
(fun_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
;;;
(defun get-all-plotconfigs (path / file_lst odbx res)
(if (setq file_lst (_kpblc-browsefiles-in-directory-nested path "*.dwg"))
(progn (setq odbx (_kpblc-odbx)
res (mapcar (function (lambda (file / conn _lst)
(setq conn (_kpblc-odbx-open file odbx)
_lst (mapcar (function (lambda (lay)
(vl-remove nil
(mapcar (function (lambda (pr / tmp)
(if (vlax-property-available-p lay pr)
(cons (strcase pr t) (vlax-get-property lay pr))
) ;_ end of if
) ;_ end of lambda
) ;_ end of function
'("configname" "CanonicalMediaName" "Name")
) ;_ end of mapcar
) ;_ end of vl-remove
) ;_ end of lambda
) ;_ end of function
(vl-sort (_kpblc-conv-vla-to-list (vla-get-layouts (cdr (assoc "obj" conn))))
(function (lambda (a b) (< (vla-get-taborder a) (vla-get-taborder b))))
) ;_ end of vl-sort
) ;_ end of mapcar
) ;_ end of setq
;; (_kpblc-odbx-close (cdr (assoc "obj" conn)))
(cons file _lst)
) ;_ end of lambda
) ;_ end of function
file_lst
) ;_ end of mapcar
) ;_ end of setq
(_kpblc-odbx-close odbx)
res
) ;_ end of progn
) ;_ end of if
) ;_ end of defun
