;|================================================
VBA совсем не знаю, поэтому могу предложить только этот вариант.
Но если дадите ссылочку на другие решения этой задачи или укажите слабые места в моей программе, буду благодарен.
А пока новая версия (открытие документов SolidWorks, APM WinMachine, Inventor, T-FLEX, КОМПАС-3D и др.,
конечно, если установлены сами программы)
Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа
Программа Дениса Флюстикова "Open_Den" от 08.02.07
Макрос для кнопки: ^C^C^P(load "Open_Den");Open_Den
Замечания и предложения по адресу fd-@mail.ru
===============================================|;
(defun c:Open_Den (/ a1 a2 a3)
(if (setq a2 (getfiled "Выберите файл" (getvar "dwgprefix") "*" 16))(progn
(setq a1 (strcase a2 T))
(cond ((or (wcmatch a1 "*.exe")
(wcmatch a1 "*.bat"))
(startapp a1))
((or (wcmatch a1 "*.dwg")
(wcmatch a1 "*.dwt")
(wcmatch a1 "*.dxf")
(wcmatch a1 "*.dws"))
(setvar "CMDECHO" 0)
(command "_.vbastmt" (strcat "AcadApplication.Documents.Open" "\42" a1 "\42"))
(setvar "CMDECHO" 1))
(T
(if (setq a2 (vl-registry-read (strcat "HKEY_CLASSES_ROOT\\" (vl-filename-extension a1))))
(if (setq a2 (vl-registry-read (strcat "HKEY_CLASSES_ROOT\\" a2 "\\shell\\Open\\command")))(progn
(if a2 (progn
(if (= (type a2) 'LIST)(setq a2 (cdr a2)))
(setq a2 (strcase (vl-string-left-trim "\"" a2) T)
a2 (substr a2 1 (vl-string-search "\"" a2))
a2 (vl-string-subst "" "%systemroot%\\system32\\" a2)
a1 (strcat "\"" a1 "\""))
(if (setq a3 (vl-string-search "%" a2))
(setq a2 (substr a2 1 a3)))
(if (setq a3 (vl-string-search ".exe " a2))
(setq a2 (substr a2 1 (+ a3 4))))
(if (wcmatch a2 "*acdsee*")
(setq a2 (startapp "mspaint.exe" a1))
(setq a2 (startapp (strcat "\"" a2 "\"") a1)))
)
)))))
)
(if (null a2)(princ "\nПрограмма для открытия файлов данного типа не найдена"))
))
(princ)
)