Тема: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

;|====================================================
Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа
Программа Дениса Флюстикова "Open_Den"
Макрос для кнопки: ^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 (= (type a2) 'LIST)(setq a2 (cdr a2)))
(setq a2 (vl-string-left-trim "\"" a2)
      a2 (substr a2 1 (vl-string-search "\"" a2))
      a2 (vl-string-subst "" "%systemroot%\\system32\\" (strcase a2 T))
      a3 (vl-string-search "%" a2)
      a1 (strcat "\"" a1 "\""))
(if a3 (setq a2 (vl-string-right-trim " " (substr a2 1 a3))))
(startapp (strcat "\"" a2 "\"") a1))
)))
)
(if (null a2)(princ "\nПрограмма для открытия файлов данного типа не найдена"))
))
(princ)
)

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

На jpg и html нулевая реакция

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

;|====================================================
У меня файлы с расширением html нормально открываются и на машинах с "Opera" и с "Internet Explorer", поэтому о причине нулевой реакции в Вашем случае могу только предполагать. А насчет jpg и других файлов, открытие которых в Windows прописано за ACDSee, здесь у меня решения пока нет, да и совета на этот случай тоже не получил ( https://www.caduser.ru/forum/topic33040.html ). А сейчас могу предложить такой вариант, где картинки открываются mspaint'ом.
Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа
Программа Дениса Флюстикова "Open_Den" от 03.02.07 (переопределение Acdsee)
Макрос для кнопки: ^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 (vl-string-left-trim "\"" a2)
      a2 (substr a2 1 (vl-string-search "\"" a2))
      a2 (vl-string-subst "" "%systemroot%\\system32\\" (strcase a2 T))
      a3 (vl-string-search "%" a2)
      a1 (strcat "\"" a1 "\""))
(if a3 (setq a2 (vl-string-right-trim " " (substr a2 1 a3))))
(if (wcmatch (strcase a2 T) "*acdsee*")
(setq a2 (startapp "mspaint.exe" a1))
(setq a2 (startapp (strcat "\"" a2 "\"") a1))))
)))))
)
(if (null a2)(princ "\nПрограмма для открытия файлов данного типа не найдена"))
))
(princ)
)

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

html у меня прописан за ИЕ7 (может в нём дело?). Открывать фиксированное приложение для зарегестрированных файлов не совсем корректно. Обычно для этого используют функцию АПИ ShellExecuteA, но как с этим в Лиспе, я не знаю. Может проще вызвать VBA функцию, которая обратится к WinAPI DDL (shell32)?

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

;|================================================
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)
)

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

;|===============================================
Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа
Программа Дениса Флюстикова "Open_Den" от 28.02.07
новое:
Открытие bak и sv$-файлов с предварительным переводом их в DWG-формат.
Остается проблема с открытием файлов, прописанных за ACDSee,
хотя на машинах с установленным XnView вмесо ACDSee все OK!
Макрос для кнопки: ^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 "*.cmd")
       (wcmatch a1 "*.com")
       (wcmatch a1 "*.pif")
       (wcmatch a1 "*.lnk")
       (wcmatch a1 "*.bat"))
(startapp a1))
      ((and (or (wcmatch a1 "*.bak")
        (wcmatch a1 "*.sv$"))
        (wcmatch (read-line (setq a3 (open a1 "r"))) "AC10*")
        )
(close a3)
(setq a1 (vl-filename-base a2))
(if (findfile (strcat (vl-filename-directory a2) "\\""" a1 ".dwg"))
(setq a1 (strcat a1 (vl-filename-extension a2))
      a3 3)
(setq a3 1))
(while a3
(if (= a3 3)
(princ (strcat "\nПапка уже содержит DWG-файл \"" (vl-filename-base a1) "\""))
(if (= a3 1)
(princ (strcat "\nВосстановление DWG-файла \"" a1 "\""))
(if (= a3 0)
(princ "\nНедопустимый символ в имени файла")
(princ (strcat "\nПапка уже содержит DWG-файл \"" a1 "\"")))))
(if (= a3 2)
(setq a3 "\nНовое имя DWG-файла:")
(setq a3 (strcat "\nНовое имя DWG-файла или <" a1 ">:")))
(setq a3 (vl-catch-all-apply 'getstring (list T a3)))
(if (= (type a3) 'STR)(progn
(setq a3 (vl-string-translate "/\\:?<*\|\"" ">>>>>>>>" (vl-string-trim " " a3)))
(if (wcmatch a3 "*>*")
(setq a3 0)
(progn
(if (= a3 "")(setq a3 a1))
(setq a1 a3
      a3 (strcat (vl-filename-directory a2) "\\""" a3 ".dwg"))
(if (findfile a3)
(setq a3 2)
(setq a1 a3
      a3 nil))
))
)
(setq a1 nil a3 nil)
)
)
(if a1 (progn
(setvar "CMDECHO" 0)
(if (vl-file-rename  a2 a1)
(command "_.vbastmt" (strcat "AcadApplication.Documents.Open" "\42" a1 "\42"))
(princ "\nПереименовать файл не удалось"))
(setvar "CMDECHO" 1))
(princ "\n*Прервано*")
))
      ((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")))
(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)
)

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

> Денис Флюстиков
Отказывается работать.
Пишет  Неизвестная команда "OPEN_DEN".
Акад 2007.
Установил штатно.

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

> jonas
Только сейчас добрался до инета.
Полностью повторил установку программы под 2007 ACAD, все OK!
Конкретную причину проблемы в твоем случае не знаю.
И хотя, наверное, это лишнее, но опишу свои действия.
Удалил старый файл. Скопированный через буфер обмена текст последнего сообщения (2007-02-28 20:42:49) вставил в блокнот и сохранил файл с именем "Open_Den.lsp". Далее этот файл поместил в папку, путь к которой прописан в "Путь доступа к вспомогательным файлам". В командную строку вставил (через буфер обмена):
(load "Open_Den")
ACAD выдал подтверждение загрузки программы сообщением C:OPEN_DEN
И при вводе в командную строку Open_Den появилось окно выбора файла для открытия.
Можно попробовать загрузить программу через "загрузка приложения", или перетащить файл "Open_Den.lsp" из проводника на поле чертежа.
Надеюсь, что проблема не в программе (?: только последней версии?) и готов выслать файл в lsp-формате. Удачи.

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

> Светлана

> Денис Флюстиков
Два варианта открытия с помощью IE. В том числе и URL

;;;  Открытие файлов с помощью IE
;;;  file_html - искомый файл
;;;  Usage
;;;   URL - (ie-open-file-v1 "www.mip.by")
;;;   LOCAL FILE (ie-open-file-v1 "D:\\TEST.JPG")
(defun ie-open-file-v1 (file_html / ie_obj)
  (vl-load-com)
  (setq file_html (vl-princ-to-string file_html))
  (if
    (or (= (vla-isurl (vla-get-utility
                        (vla-get-activedocument (vlax-get-acad-object))
                        )
                      file_html
                      )
           :vlax-true
           )
        (and (setq file_html (findfile file_html))
             (vl-file-systime file_html)
             )
        )
     (progn
       (setq ie_obj (vlax-get-or-create-object
                      "InternetExplorer.Application"
                      )
             )
       (vlax-invoke ie_obj 'navigate2 file_html)
       (vla-put-visible ie_obj t)
       (vlax-release-object ie_obj)
       )
     (alert (strcat "Невозможно найти " file_ftml))
     )
  (gc)
  (princ)
  )
;;;  Открытие файлов с помощью IE
;;;  file_html - искомый файл
;;;  Usage
;;;    URL - (ie-open-file-v2 "www.mip.by")
;;;    LOCAL FILE (ie-open-file-v2 "D:\\TEST.JPG")
(defun ie-open-file-v2 (file_html / ie_obj)
  (vl-load-com)
  (setq file_html (vl-princ-to-string file_html))
  (if
    (or (= (vla-isurl (vla-get-utility
                        (vla-get-activedocument (vlax-get-acad-object))
                        )
                      file_html
                      )
           :vlax-true
           )
        (and (setq file_html (findfile file_html))
             (vl-file-systime file_html)
             )
        )
     (progn
       (vlax-invoke-method
         (setq ie_obj (vlax-get-or-create-object "wscript.shell"))
         "run"
         (strcat "Iexplore.exe " file_html)
         1
         :vlax-true
         )
       (vlax-release-object ie_obj)
       )
     (alert (strcat "Невозможно найти " file_ftml))
     )
  (gc)
  (princ)
  )
(defun C:ie (/ ie_obj)(ie-open-file-v1 "mipgost.mht"))

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

> Денис Флюстиков
Спасибо, уже наладил.
Убрал из файла -
<Программа Дениса Флюстикова "Open_Den" от 28.02.07
новое:
Открытие bak и sv$-файлов с предварительным переводом их в DWG-формат.
Остается проблема с открытием файлов, прописанных за ACDSee,
хотя на машинах с установленным XnView вмесо ACDSee все OK!
Макрос для кнопки: ^C^C^P(load "Open_Den");Open_Den>
и все заработало.
Еще раз спасибо.

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

Остается проблема с открытием файлов, прописанных за ACDSee,
хотя на машинах с установленным XnView вмесо ACDSee все OK!

Вот вариант, с AcdSee 8.0 работает. Добавлял на коленке, поэтому может не самым рациональным способом

(defun c:Open_Den (/ a1 a2 a3 a4 ws)
(if (setq a2 (getfiled "Выберите файл" (getvar "dwgprefix") "*" 16))(progn
(setq a1 (strcase a2 T))
(cond ((or (wcmatch a1 "*.exe")
(wcmatch a1 "*.cmd")
(wcmatch a1 "*.com")
(wcmatch a1 "*.pif")
(wcmatch a1 "*.lnk")
(wcmatch a1 "*.bat"))
(startapp a1))
((and (or (wcmatch a1 "*.bak")
(wcmatch a1 "*.sv$"))
(wcmatch (read-line (setq a3 (open a1 "r"))) "AC10*")
)
(close a3)
(setq a1 (vl-filename-base a2))
(if (findfile (strcat (vl-filename-directory a2) "\\""" a1 ".dwg"))
(setq a1 (strcat a1 (vl-filename-extension a2))
a3 3)
(setq a3 1))
(while a3
(if (= a3 3)
(princ (strcat "\nПапка уже содержит DWG-файл \"" (vl-filename-base a1) "\""))
(if (= a3 1)
(princ (strcat "\nВосстановление DWG-файла \"" a1 "\""))
(if (= a3 0)
(princ "\nНедопустимый символ в имени файла")
(princ (strcat "\nПапка уже содержит DWG-файл \"" a1 "\"")))))
(if (= a3 2)
(setq a3 "\nНовое имя DWG-файла:")
(setq a3 (strcat "\nНовое имя DWG-файла или <" a1 ">:")))
(setq a3 (vl-catch-all-apply 'getstring (list T a3)))
(if (= (type a3) 'STR)(progn
(setq a3 (vl-string-translate "/\\:?<*\|\"" ">>>>>>>>" (vl-string-trim " " a3)))
(if (wcmatch a3 "*>*")
(setq a3 0)
(progn
(if (= a3 "")(setq a3 a1))
(setq a1 a3
a3 (strcat (vl-filename-directory a2) "\\""" a3 ".dwg"))
(if (findfile a3)
(setq a3 2)
(setq a1 a3
a3 nil))
))
)
(setq a1 nil a3 nil)
)
)
(if a1 (progn
(setvar "CMDECHO" 0)
(if (vl-file-rename a2 a1)
(command "_.vbastmt" (strcat "AcadApplication.Documents.Open" "\42" a1 "\42"))
(princ "\nПереименовать файл не удалось"))
(setvar "CMDECHO" 1))
(princ "\n*Прервано*")
))
((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")))
(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))))
(setq a4 (strcat  "\"" a2  "\"" " " a1))                       ;<=Add
(vlax-invoke-method                                            ;<=Add
         (setq ws (vlax-get-or-create-object "wscript.shell")) ;<=Add
         "run"                                                 ;<=Add
         a4                                                    ;<=Add
         1                                                     ;<=Add
         :vlax-true                                            ;<=Add
         )                                                     ;<=Add
       (vlax-release-object ws)                                ;<=Add
;;;(if (wcmatch a2 "*acdsee*")
;;;(setq a2 (startapp "mspaint.exe" a1))
;;;(setq a2 (startapp (strcat "\"" a2 "\"") a1)))
)
))))
)
(if (null a2)(princ "\nПрограмма для открытия файлов данного типа не найдена"))
))
(princ)
)

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

> jonas
Можно и не убирать, если оставить первую строчку ;|===========

> VVA
Спасибо за вариант, но сейчас проблема со временем, позже обязательно ознакомлюсь с кодом повнимательней.
А пока вопрос
Как я понимаю это варианты при установленном IE, а если, например, на машине "Opera" (установили ACAD при IE, а позже Explorer заменили на "Opera")?

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

> Денис Флюстиков
Те два варианта по IE писались специально для отрытия IE (например Opera не понимает *.mht файл). По умолчанию можно открывать так, как у тебя и делалось (то, что зарегестрировано за расширением), только я для этого использовал не startapp а объект wscript.shell. Он корректней открывает зарегестрированные приложения + ищет приложения в отличие от starpapp в путях Windows (см. ie-open-file-v2 там нигде путь к IE не пишется).

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

> VVA
БОЛЬШОЕ спасибо за вариант, а то я уже перестал бороться с невозможностью открытия ACDSee (сейчас картинки открылись и шестым ACDSee)
Только перед строчкой:
(vlax-invoke-method
Наверное, надо поставить:
(vl-load-com)

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

Денис Флюстиков пишет:

Только перед строчкой:
(vlax-invoke-method
Наверное, надо поставить:
(vl-load-com)

Тогда уж в самом начале, т.к. VLISP'овские ф-ции используются и раньше, например vl-filename-directory

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

> VVA
В твоем варианте обнаружился неудобный момент, когда в ACAD’е невозможно работать пока не закрыл приложение (даже если оно уже неактивное) открытое ранее с помощью "Open_Den".

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

> Денис Флюстиков
моментик

(defun c:Open_Den (/ a1 a2 a3 a4 ws)
(if (setq a2 (getfiled "Выберите файл" (getvar "dwgprefix") "*" 16))(progn
(setq a1 (strcase a2 T))
(cond ((or (wcmatch a1 "*.exe")
(wcmatch a1 "*.cmd")
(wcmatch a1 "*.com")
(wcmatch a1 "*.pif")
(wcmatch a1 "*.lnk")
(wcmatch a1 "*.bat"))
(startapp a1))
((and (or (wcmatch a1 "*.bak")
(wcmatch a1 "*.sv$"))
(wcmatch (read-line (setq a3 (open a1 "r"))) "AC10*")
)
(close a3)
(setq a1 (vl-filename-base a2))
(if (findfile (strcat (vl-filename-directory a2) "\\""" a1 ".dwg"))
(setq a1 (strcat a1 (vl-filename-extension a2))
a3 3)
(setq a3 1))
(while a3
(if (= a3 3)
(princ (strcat "\nПапка уже содержит DWG-файл \"" (vl-filename-base a1) "\""))
(if (= a3 1)
(princ (strcat "\nВосстановление DWG-файла \"" a1 "\""))
(if (= a3 0)
(princ "\nНедопустимый символ в имени файла")
(princ (strcat "\nПапка уже содержит DWG-файл \"" a1 "\"")))))
(if (= a3 2)
(setq a3 "\nНовое имя DWG-файла:")
(setq a3 (strcat "\nНовое имя DWG-файла или <" a1 ">:")))
(setq a3 (vl-catch-all-apply 'getstring (list T a3)))
(if (= (type a3) 'STR)(progn
(setq a3 (vl-string-translate "/\\:?<*\|\"" ">>>>>>>>" (vl-string-trim " " a3)))
(if (wcmatch a3 "*>*")
(setq a3 0)
(progn
(if (= a3 "")(setq a3 a1))
(setq a1 a3
a3 (strcat (vl-filename-directory a2) "\\""" a3 ".dwg"))
(if (findfile a3)
(setq a3 2)
(setq a1 a3
a3 nil))
))
)
(setq a1 nil a3 nil)
)
)
(if a1 (progn
(setvar "CMDECHO" 0)
(if (vl-file-rename a2 a1)
(command "_.vbastmt" (strcat "AcadApplication.Documents.Open" "\42" a1 "\42"))
(princ "\nПереименовать файл не удалось"))
(setvar "CMDECHO" 1))
(princ "\n*Прервано*")
))
((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")))
(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))))
(setq a4 (strcat  "\"" a2  "\"" " " a1))                       ;<=Add
(vlax-invoke-method                                            ;<=Add
         (setq ws (vlax-get-or-create-object "wscript.shell")) ;<=Add
         "run"                                                 ;<=Add
         a4                                                    ;<=Add
         1                                                     ;<=Add
         :vlax-false                                           ;<=Add <=Changed
         )                                                     ;<=Add
       (vlax-release-object ws)                                ;<=Add
;;;(if (wcmatch a2 "*acdsee*")
;;;(setq a2 (startapp "mspaint.exe" a1))
;;;(setq a2 (startapp (strcat "\"" a2 "\"") a1)))
)
))))
)
(if (null a2)(princ "\nПрограмма для открытия файлов данного типа не найдена"))
))
(princ)
)

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

Все-таки добавил (vl-load-com)
Многократное
(or (wcmatch a1 "*.dwg")
(wcmatch a1 "*.dwt")
(wcmatch a1 "*.dxf")
(wcmatch a1 "*.dws")
)
заменил на (wcmatch a1 "*.dwg,*.dwt,*.dxf,*.dws")
Надеюсь ничего не испортил

(defun c:Open_Den  (/ a1 a2 a3 a4 ws)
  (vl-load-com)
  (if (setq a2 (getfiled "Выберите файл" (getvar "dwgprefix") "*" 16))
    (progn
      (setq a1 (strcase a2 T))
      (cond
    ((wcmatch a1 "*.exe,*.cmd,*.com,*.pif,*.lnk,*.bat")
     (startapp a1)
     )
    ((and (wcmatch a1 "*.bak,*.sv$")
          (wcmatch (read-line (setq a3 (open a1 "r"))) "AC10*")
          )
     (close a3)
     (setq a1 (vl-filename-base a2))
     (if (findfile (strcat (vl-filename-directory a2) "\\" "" a1 ".dwg"))
        (setq a1 (strcat a1 (vl-filename-extension a2)) a3 3)
        (setq a3 1)
        )
     (while    a3
       (if (= a3 3)
         (princ (strcat "\nПапка уже содержит DWG-файл \""
                (vl-filename-base a1)
                "\""
                )
            )
         (if (= a3 1)
           (princ
         (strcat "\nВосстановление DWG-файла \"" a1 "\""))
           (if (= a3 0)
         (princ "\nНедопустимый символ в имени файла")
         (princ
           (strcat "\nПапка уже содержит DWG-файл \""
               a1
               "\"")
           )
         )
           )
         )
       (if (= a3 2)
         (setq a3 "\nНовое имя DWG-файла:")
         (setq a3
            (strcat "\nНовое имя DWG-файла или <" a1 ">:"))
         )
       (setq a3 (vl-catch-all-apply 'getstring (list T a3)))
       (if (= (type a3) 'STR)
         (progn
           (setq a3    (vl-string-translate
              "/\\:?<*\|\""
              ">>>>>>>>"
              (vl-string-trim " " a3)
              )
             )
           (if (wcmatch a3 "*>*")
         (setq a3 0)
         (progn
           (if (= a3 "")
             (setq a3 a1)
             )
           (setq a1 a3
             a3 (strcat (vl-filename-directory a2)
                    "\\"
                    ""
                    a3
                    ".dwg"
                    )
             )
           (if (findfile a3)
             (setq a3 2)
             (setq a1 a3
               a3 nil
               )
             )
           )
         )
           )
         (setq a1 nil a3 nil)
         )
       )
     (if a1
       (progn
         (setvar "CMDECHO" 0)
         (if (vl-file-rename a2 a1)
           (command    "_.vbastmt"
            (strcat    "AcadApplication.Documents.Open"
                "\42"
                a1
                "\42"
                )
            )
           (princ "\nПереименовать файл не удалось")
           )
         (setvar "CMDECHO" 1)
         )
       (princ "\n*Прервано*")
       )
     )
    ((wcmatch a1 "*.dwg,*.dwt,*.dxf,*.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"
                  )
              )
             )
         (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)))
           )
         (setq a4 (strcat "\"" a2 "\"" " " a1)) ;<=Add
         (vlax-invoke-method          ;<=Add
           (setq ws (vlax-get-or-create-object
                  "wscript.shell"))
                          ;<=Add
           "run"              ;<=Add
           a4                  ;<=Add
           1                  ;<=Add
           :vlax-false              ;<=Add <=Changed
           )                  ;<=Add
         (vlax-release-object ws)      ;<=Add
;;;(if (wcmatch a2 "*acdsee*")
;;;(setq a2 (startapp "mspaint.exe" a1))
;;;(setq a2 (startapp (strcat "\"" a2 "\"") a1)))
         )
           )
         )
       )
     )
    )
      (if (null a2)
    (princ
      "\nПрограмма для открытия файлов данного типа не найдена"
      )
    )
      )
    )
  (princ)
  )

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

> VVA
Еще раз спасибо, погонял программу, все файлы с зарегистрированными расширениями открываются и не мешают ACAD'у.
И, наверное, в данном варианте проверка (как была у меня) на открытие уже лишняя.

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

;|====================================================
Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа
Программа Дениса Флюстикова "Open_Den" от 02.03.07
Заметил, что программа не открыла файлы КОМПАСа с установленным на машине только "KOMPAS-3D Viewer V8 Plus"
(скорее всего это проблема прошлых версий "Open_Den" со всеми вьюверами).
Код подправил
Макрос для кнопки: ^C^C^P(load "Open_Den");Open_Den
Замечания и предложения по адресу fd-@mail.ru
Большое спасибо VVA за помощь в доработке программы
====================================================|;
(defun c:Open_Den (/ a1 a2 a3)
(if (setq a2 (getfiled "Выберите файл" (getvar "dwgprefix") "*" 16))(progn
(vl-load-com)
(setq a1 (strcase a2 T))
(cond ((wcmatch a1 "*.exe,*.cmd,*.com,*.pif,*.lnk,*.bat")
(startapp a1))
      ((and (wcmatch a1 "*.bak,*.sv$")
        (wcmatch (read-line (setq a3 (open a1 "r"))) "AC10*")
        )
(close a3)
(setq a1 (vl-filename-base a2))
(if (findfile (strcat (vl-filename-directory a2) "\\""" a1 ".dwg"))
(setq a1 (strcat a1 (vl-filename-extension a2))
      a3 3)
(setq a3 1))
(while a3
(if (= a3 3)
(princ (strcat "\nПапка уже содержит DWG-файл \"" (vl-filename-base a1) "\""))
(if (= a3 1)
(princ (strcat "\nВосстановление DWG-файла \"" a1 "\""))
(if (= a3 0)
(princ "\nНедопустимый символ в имени файла")
(princ (strcat "\nПапка уже содержит DWG-файл \"" a1 "\"")))))
(if (= a3 2)
(setq a3 "\nНовое имя DWG-файла:")
(setq a3 (strcat "\nНовое имя DWG-файла или <" a1 ">:")))
(setq a3 (vl-catch-all-apply 'getstring (list T a3)))
(if (= (type a3) 'STR)(progn
(setq a3 (vl-string-translate "/\\:?<*\|\"" ">>>>>>>>" (vl-string-trim " " a3)))
(if (wcmatch a3 "*>*")
(setq a3 0)
(progn
(if (= a3 "")(setq a3 a1))
(setq a1 a3
      a3 (strcat (vl-filename-directory a2) "\\""" a3 ".dwg"))
(if (findfile a3)
(setq a3 2)
(setq a1 a3
      a3 nil))
))
)
(setq a1 nil a3 nil)
)
)
(if a1 (progn
(setvar "CMDECHO" 0)
(if (vl-file-rename  a2 a1)
(command "_.vbastmt" (strcat "AcadApplication.Documents.Open" "\42" a1 "\42"))
(princ "\nПереименовать файл не удалось"))
(setvar "CMDECHO" 1))
(princ "\n*Прервано*")
))
      ((wcmatch a1 "*.dwg,*.dwt,*.dxf,*.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 a3 (vl-registry-read (strcat "HKEY_CLASSES_ROOT\\" a2 "\\shell\\Open\\command")))
(setq a2 a3)
(setq a2 (vl-registry-read (strcat "HKEY_CLASSES_ROOT\\" a2 "\\shell\\view\\command")))))
(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))))
(vlax-invoke-method (setq a3 (vlax-get-or-create-object "wscript.shell"))
  "run" (strcat  "\"" a2  "\"" " " a1) 1 :vlax-false)
(vlax-release-object a3)
)
))
)
(if (null a2)(princ "\nПрограмма для открытия файлов данного типа не найдена"))
))
(princ)
)

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

А можно расписать порядок установки приложения по пунктам. С компьютером на вы

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

> Фил
Данная программа подгружается в ACAD и запускается, как и все LISP-приложения. Как это делается не раз говорилось и на этом форуме, есть и в справке ACAD'а. Кратенькое описание смотри сообщение (2007-03-02 11:26:29) на этой ветке. Более подробно можешь найти по поиску, если есть конкретные вопросы, можно и в fd-@mail.ru , постараюсь ответить, хотя тоже с компьютером на вы.

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

;|=======================================
Открытие различных типов файлов из папки активного DWG-чертежа, а
при выборе bak или sv$-файлов с предварительным переводом их в DWG-формат
Программа Дениса Флюстикова "Open_Den" от 13.06.07
Увеличено количество видов открываемых файлов;
Активация DWG-чертежа без повторного открытия.
Макрос для кнопки: ^C^C^P(load "Open_Den");Open_Den
Большое спасибо VVA за помощь в доработке программы
===========================================|;

(defun c:Open_Den (/ a1 a2 a3 a4)
(if (setq a2 (getfiled "" (getvar "dwgprefix") "*" 16))(progn
(vl-load-com)
(setq a1 (strcase a2 T))
(if (vl-filename-extension a2)
(cond ((wcmatch a1 "*.exe,*.cmd,*.com,*.pif,*.lnk,*.bat,*.msi,*.dat")
(vlax-invoke-method (setq a3 (vlax-get-or-create-object "wscript.shell"))
  "run" (strcat  "\"" a2  "\"") 1 :vlax-false)
(vlax-release-object a3)
)
      ((and (wcmatch a1 "*.bak,*.sv$")
        (wcmatch (read-line (setq a3 (open a1 "r"))) "AC10*")
        )
(close a3)
(setq a1 (vl-filename-base a2))
(if (findfile (strcat (vl-filename-directory a2) "\\""" a1 ".dwg"))
(setq a1 (strcat a1 (vl-filename-extension a2))
      a3 3)
(setq a3 1))
(while a3
(if (= a3 3)
(princ (strcat "\nПапка уже содержит DWG-файл \"" (vl-filename-base a1) "\""))
(if (= a3 1)
(princ (strcat "\nВосстановление DWG-файла \"" a1 "\""))
(if (= a3 0)
(princ "\nНедопустимый символ в имени файла")
(princ (strcat "\nПапка уже содержит DWG-файл \"" a1 "\"")))))
(if (= a3 2)
(setq a3 "\nНовое имя DWG-файла:")
(setq a3 (strcat "\nНовое имя DWG-файла или <" a1 ">:")))
(setq a3 (vl-catch-all-apply 'getstring (list T a3)))
(if (= (type a3) 'STR)(progn
(setq a3 (vl-string-translate "/\\:?<*\|\"" ">>>>>>>>" (vl-string-trim " " a3)))
(if (wcmatch a3 "*>*")
(setq a3 0)
(progn
(if (= a3 "")(setq a3 a1))
(setq a1 a3
      a3 (strcat (vl-filename-directory a2) "\\""" a3 ".dwg"))
(if (findfile a3)
(setq a3 2)
(setq a1 a3
      a3 nil))
))
)
(setq a1 nil a3 nil)
)
)
(if a1 (progn
(setvar "CMDECHO" 0)
(if (vl-file-rename  a2 a1)
(command "_.vbastmt" (strcat "AcadApplication.Documents.Open\42" a1 "\42"))
(princ "\nПереименовать файл не удалось"))
(setvar "CMDECHO" 1))
))
      ((wcmatch a1 "*.dwg,*.dwt,*.dxf,*.dws")
(setvar "CMDECHO" 0)
(setq a3 0)
(vlax-for doc (vla-get-Documents (vlax-get-acad-object))
(if (= (strcase (vla-get-fullname doc) T) a1)(progn
(princ (strcat "\n" a2 " в данный момент открыт"))
(command "_.vbastmt" (strcat "AcadApplication.Documents.Item(" (itoa a3) ").Activate"))
(setq a1 nil)
))
(setq a3 (1+ a3))
)
(if a1 (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 a3 (strcat "HKEY_CLASSES_ROOT\\" a2 "\\shell")
      a4 (vl-registry-descendents a3))
(progn (setq a4 (append '("open" "view") a4))
(while a4
(if (setq a2 (vl-registry-read (strcat a3 "\\" (car a4) "\\command")))
(setq a4 nil))
(setq a4 (cdr a4))))
(setq a2 nil)
))
(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 (not (wcmatch a2 "rundll32*"))
(setq a1 (strcat  "\"" a2  "\"" " " a1)))
(vlax-invoke-method (setq a3 (vlax-get-or-create-object "wscript.shell"))
  "run" a1 1 :vlax-false)
(vlax-release-object a3)
)
))
)
(setq a2 nil))
(if (null a2)(princ "\nПрограмма для открытия файлов данного типа не найдена"))
))
(princ)
)

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

kak ispolzevat eti lispi

Re: LISP. Открытие файлов WORD, EXCEL и других типов из папки активного DWG-чертежа

> Dima
Попробую ответить, хотя не уверен, что правильно понял слово «ispolzevat».
Данный LISP подгружается как и все подобные. Как это делается много раз объяснялось и на здешнем форуме и на других, на dwg.ru, например есть хорошая инструкция от VVA http://dwg.ru/art/8 . Правда, у меня иногда не корректно копировался код «готовых программ» в блокнот, происходила разбивка VL-функций  и комментариев по строчкам. Если у тебя возникнут подобные проблемы, готов выслать программу в готовом LISP-формате. Удачи!