DwgRuLispLib: Команда. Загрузка lisp файлов из указанной папки

VVA · 07.12.2007, 12:21

Команда для загрузки лисп (*.lsp) файлов с указанной папки, включая все вложенные папки. Может рассматриваться как некий инструмент для быстой подгрузки лисп при использовании части библиотеки или при тестировании/ отладке.

Код:

[Выделить все]

;;DWGRU Load Lisp
;; Команда DWGRULL
;; Команда для загрузки  лисп (*.lsp) файлов с указанной папки, включая все вложенные папки
;;;Папку можно задать явно
;;;Редактировать следующие строчки в файле
;|
(setq  path (BrowseFolder)) ;_ ;Выбор папки загрузки
;;; Задание папки явно 
;;;(setq  path "G:\\Work\\4ACAD\\MIP\\WORK\\DwgRuLispLib")
|;
(defun C:DWGRULL ( /              file_list      file&
                  z-files-in-directory          BrowseFolder
                  path           good           bad
                 )
;|=============================================================================
*    функция z-files-in-directory возвращает список файлов находящаяся в заданной
* директории
*    Автор : Зуенко Виталий (ZZZ)
*  Параметры:
*    directory  путь к папке например "D:\\Мои документы\\ZEF\\Lisp"
*    pattern    шаблон например "*.lsp" или список '("*.dwg" "*.dxf")
*    nested    искать в вложенных папках: t (да) или nil (нет)
* Пример вызова:
(z-files-in-directory "D:\\Мои документы\\ZEF\\Lisp" "*.dwg" t)
(z-files-in-directory "D:\\Мои документы\\ZEF\\Lisp" '("*.dwg" "*.dwt") t)
=============================================================================|;
  (defun z-files-in-directory (directory pattern nested /)
    (if (not (listp pattern))
      (setq pattern (list pattern))
    ) ;_ end of if
    (if nested
      (apply
        'append
        (append
          (mapcar '(lambda (_pattern)
                     (mapcar '(lambda (f) (strcat directory "\\" f))
                             (vl-directory-files directory _pattern 1)
                     ) ;_ end of mapcar
                   ) ;_ end of lambda
                  pattern
          ) ;_ mapcar
          (mapcar
            '(lambda (d)
               (z-files-in-directory
                 (strcat directory "\\" d)
                 pattern
                 nested
               ) ;_ end of z-files-in-directory
             ) ;_ end of lambda
            (vl-remove
              "."
              (vl-remove ".." (vl-directory-files directory nil -1))
            ) ;_ end of vl-remove
          ) ;_ end of mapcar
        ) ;_ end of append
      ) ;_ end of apply
      (apply 'append
             (mapcar '(lambda (_pattern)
                        (mapcar '(lambda (f) (strcat directory "\\" f))
                                (vl-directory-files directory _pattern 1)
                        ) ;_ end of mapcar
                      ) ;_ end of lambda
                     pattern
             ) ;_ end of mapcar
      ) ;_ end of apply
    ) ;_ end of if
  ) ;_ end of defun
  (defun BrowseFolder (/ ShlObj Folder FldObj OutVal)
;;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=21054YY    
;;; С отображение файлов    
;;;(setq Folder (vlax-invoke-method ShlObj 'BrowseForFolder 0 "" 16384))   
    (vl-load-com)
    (setq ShlObj (vla-getinterfaceobject
                   (vlax-get-acad-object)
                   "Shell.Application"
                 ) ;_ end of vla-getInterfaceObject
          Folder (vlax-invoke-method ShlObj 'BrowseForFolder 0 "" 0)
    ) ;_ 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
  (setq path (BrowseFolder)) ;_ ;Выбор папки загрузки
;;; Задание папки явно 
;;;(setq  path "G:\\Work\\4ACAD\\MIP\\WORK\\DwgRuLispLib")
  (vl-load-com)
  (setq good 0
        bad 0
  ) ;_ end of setq
  (setq file_list
         (z-files-in-directory
           path
           "*.lsp"
           t
         ) ;_ end of z-files-in-directory
  ) ;_ end of setq
  (foreach file& file_list
    (grtext -1 (strcat "Load " (vl-filename-base file&)))
    (if (vl-catch-all-error-p
          (vl-catch-all-apply 'load (list file&))
        ) ;_ end of VL-CATCH-ALL-ERROR-P
      (progn
        (setq bad (1+ bad))
        (princ (strcat "\nОшибка в файле " file&))
      ) ;_ end of progn
      (setq good (1+ good))
    ) ;_ end of if
  ) ;_ end of foreach
  (vl-cmdf "_.Redraw")
  (princ (strcat "\nПуть " path))
  (princ (strcat "\n Загружено "
                 (itoa good)
                 " файлов сбойных "
                 (itoa bad)
         ) ;_ end of strcat
  ) ;_ end of princ
  (princ)
) ;_ end of defun
(princ
  "\nДля загрузки файлов наберите в командной строке DWGRULL"
) ;_ end of princ

ShaggyDoc · 07.12.2007, 13:24

Мне кажется, такие C:КОМАНДЫ в библиотеку функций включать не нужно. Это для "готовых программ" желающим.

Необходимость загрузки кучи DWG действительно есть, но, на уровне библиотеки функций, её надо разбивать:

1. Надежная загрузка одного файла с заданным полным именем.
2. Загрузка группы файлов из списка полных имён. Имена могут быть и в разных папках.
3. Получение списка имён. Тут могут быть разные варианты.

Зачем же в теле что-то редактировать? Функция должна быть готовой к применению.

Кроме того:
Ловушки ошибок надо делать из уже имеющихся в библиотеке функций. Vl-load-com не надо вообще в функции толкать - это должно быть в единственном месте, гда загружается сама библиотека.

А LSP зачем кучей загружать? Для самой библиотеки мы имеем проект и всегда нужный из него загрузим одним щелчком?

Кулик Алексей aka kpblc · 07.12.2007, 13:54

lsp кучей иногда приходится грузить. В остальном:

Код:

[Выделить все]

;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * dwgru-browsefolder
;;; *
;;; * 06/12/007 Версия 0002.
;;; * Функция загрузки лиспов разделена на несколько.
;;; ************************************************************************
;;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=21054YY

(defun dwgru-browsefolder (title show-files / shlobj folder fldobj outval)
;;;  Функция получения пути (или файла)
;;;  Параметры вызова:
;;;	title		заголовок, печатаемый в окне. nil -> "". Допускаются
;;;			только строковые значения либо nil.
;;;	show-files	показывать файлы (t | nil)
;;;  Возвращаемое значение:
;;;	полный путь к указанной папке или файлу либо nil в случае нажатия Esc
;;; пользователем.
;;;  Обнаружен "баг": если в качестве результата указывается сетевая папка,
;;; сохраненная в NetHood, результат может быть неочевидным.
;;; Примеры вызова:
  ;|
(dwgru-browsefolder nil nil)	; вызвать окно показа только папок. В
	; заголовке окна ничего не пишется
(dwgru-browsefolder "Укажите папку установки" nil)	; Вызвать окно показа
	; папок. В заголовке окна пишется "Укажите папку установки"
(dwgru-browsefolder nil t)	; вызвать окно, с показыванием всех файлов
	; (вроде бы в соответствии с настройками Проводника).
|;
  (setq shlobj (vla-getinterfaceobject
                 (vlax-get-acad-object)
                 "Shell.Application"
                 ) ;_ end of vla-getinterfaceobject
        folder (vlax-invoke-method shlobj
                                   'browseforfolder
                                   0
                                   (cond
                                     (title)
                                     (t "")
                                     ) ;_ end of cond
                                   (cond (show-files 16384)
                                         (t 0)
                                         ) ;_ end of cond
                                   ) ;_ end of vlax-invoke-method
        ) ;_ end of setq
  (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

Код:

[Выделить все]

;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * dwgru-browsefolder
;;; *
;;; * 06/12/007 Версия 0002.
;;; * Функция загрузки лиспов разделена на несколько.
;;; ************************************************************************

(defun dwgru-browsefiles-in-directory (directory pattern nested /)
;;;    Переименована из z-files-in-directory
;;;    функция возвращает список файлов по маске находящаяся в заданной
;;; директории
;;;    Автор : Зуенко Виталий (ZZZ)
;;;  Параметры:
;;;    directory  путь к папке например "D:\\Мои документы\\ZEF\\Lisp"
;;;    pattern    шаблон например "*.lsp" или список '("*.dwg" "*.dxf")
;;;    nested    искать в вложенных папках: t (да) или nil (нет)
;;; Пример вызова:
  ;|
(dwgru-browsefiles-in-directory "D:\\Мои документы\\ZEF\\Lisp" "*.lsp" t)
(dwgru-browsefiles-in-directory "D:\\Мои документы\\ZEF\\Lisp" '("*.lsp" "*.fas") t)
|;
  (if (not (listp pattern))
    (setq pattern (list pattern))
    ) ;_ if
  (if nested
    (apply
      'append
      (append
        (mapcar '(lambda (_pattern)
                   (mapcar '(lambda (f) (strcat directory "\\" f))
                           (vl-directory-files directory _pattern 1)
                           ) ;_ list
                   ) ;_ lambda
                pattern
                ) ;_ mapcar
        (mapcar
          '(lambda (d)
             (dwgru-browsefiles-in-directory
               (strcat directory "\\" d)
               pattern
               nested
               ) ;_ end of dwgru-browsefiles-in-directory
             ) ;_ lambda
          (vl-remove
            "."
            (vl-remove ".."
                       (vl-directory-files directory nil -1)
                       ) ;_ end of vl-remove
            ) ;_ vl-remove
          ) ;_ mapcar
        ) ;_ append
      ) ;_ append
    (apply
      'append
      (mapcar '(lambda (_pattern)
                 (mapcar '(lambda (f) (strcat directory "\\" f))
                         (vl-directory-files directory _pattern 1)
                         ) ;_ list
                 ) ;_ lambda
              pattern
              ) ;_ end of mapcar
      ) ;_ end of apply
    ) ;_ end of if
  ) ;_ end of defun

Кулик Алексей aka kpblc · 07.12.2007, 13:57

Ну и собственно вариант загрузки лиспов (код не проверял - попросту некогда

)

Код:

[Выделить все]

(vl-load-com)
(defun dwgru-debug-lib-loading (path
                                /
                                func_dwgru-browsefolder
                                func_dwgru-browsefiles-in-directory
                                count
                                )
                               ;|
*    Функция подгрузки всех лиспов библиотеки из указанного пути
*    Параметры вызова:
	path	путь в формате lisp'a. nil -> брать из реестра.
		t -> запрос пользователя
|;

;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * dwgru-browsefolder
;;; *
;;; * 06/12/007 Версия 0002.
;;; * Функция загрузки лиспов разделена на несколько.
;;; ************************************************************************
;;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=21054YY

  (defun func_dwgru-browsefolder
         (title show-files / shlobj folder fldobj outval)
;;;  Функция получения пути (или файла)
;;;  Параметры вызова:
;;;	title		заголовок, печатаемый в окне. nil -> "". Допускаются
;;;			только строковые значения либо nil.
;;;	show-files	показывать файлы (t | nil)
;;;  Возвращаемое значение:
;;;	полный путь к указанной папке или файлу либо nil в случае нажатия Esc
;;; пользователем.
;;;  Обнаружен "баг": если в качестве результата указывается сетевая папка,
;;; сохраненная в NetHood, результат может быть неочевидным.
;;; Примеры вызова:
    ;|
(dwgru-browsefolder nil nil)	; вызвать окно показа только папок. В
	; заголовке окна ничего не пишется
(dwgru-browsefolder "Укажите папку установки" nil)	; Вызвать окно показа
	; папок. В заголовке окна пишется "Укажите папку установки"
(dwgru-browsefolder nil t)	; вызвать окно, с показыванием всех файлов
	; (вроде бы в соответствии с настройками Проводника).
|;
    (setq shlobj (vla-getinterfaceobject
                   (vlax-get-acad-object)
                   "Shell.Application"
                   ) ;_ end of vla-getinterfaceobject
          folder (vlax-invoke-method shlobj
                                     'browseforfolder
                                     0
                                     (cond
                                       (title)
                                       (t "")
                                       ) ;_ end of cond
                                     (cond (show-files 16384)
                                           (t 0)
                                           ) ;_ end of cond
                                     ) ;_ end of vlax-invoke-method
          ) ;_ end of setq
    (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 func_dwgru-browsefiles-in-directory (directory pattern nested /)
    (if (not (listp pattern))
      (setq pattern (list pattern))
      ) ;_ if
    (if nested
      (apply
        'append
        (append
          (mapcar '(lambda (_pattern)
                     (mapcar '(lambda (f) (strcat directory "\\" f))
                             (vl-directory-files directory _pattern 1)
                             ) ;_ list
                     ) ;_ lambda
                  pattern
                  ) ;_ mapcar
          (mapcar
            '(lambda (d)
               (func_dwgru-browsefiles-in-directory
                 (strcat directory "\\" d)
                 pattern
                 nested
                 ) ;_ end of loc:files-in-directory
               ) ;_ lambda
            (vl-remove
              "."
              (vl-remove ".."
                         (vl-directory-files directory nil -1)
                         ) ;_ end of vl-remove
              ) ;_ vl-remove
            ) ;_ mapcar
          ) ;_ append
        ) ;_ append
      (apply
        'append
        (mapcar '(lambda (_pattern)
                   (mapcar '(lambda (f) (strcat directory "\\" f))
                           (vl-directory-files directory _pattern 1)
                           ) ;_ list
                   ) ;_ lambda
                pattern
                ) ;_ end of mapcar
        ) ;_ end of apply
      ) ;_ end of if
    ) ;_ end of defun

  (mapcar '(lambda (a) (setq a nil))
          (vl-remove-if-not
            '(lambda (x)
               (and (wcmatch (strcase x) "*DWGRU*")
                    (/= (strcase x) (strcase "dwgru-debug-lib-loading"))
                    ) ;_ end of and
               ) ;_ end of lambda
            (atoms-family 1)
            ) ;_ end of vl-remove-if-not
          ) ;_ end of mapcar
  (if
    (cond
      ((= (type path) 'str) path)
      (path
       (setq path (func_dwgru-browsefolder "Каталог лиспов для загрузки" nil))
       )
      (t
       (setq path (vl-registry-read
                    "HKEY_LOCAL_MACHINE\\SOFTWARE\\DWGru\\LispLib\\"
                    "RootDir"
                    ) ;_ end of vl-registry-read
             ) ;_ end of setq
       )
      ) ;_ end of cond
     (progn

       (foreach file (func_files-in-directory path "*.lsp" t)
         (if (equal (load file "Fail") "Fail")
           (setq count (cons file count))
           ) ;_ end of if
         ) ;_ end of foreach
       (if count
         (alert
           (apply 'strcat (mapcar '(lambda (x) (strcat x "\n")) (reverse count)))
           ) ;_ end of alert
         ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
  ) ;_ end of defun

VVA · 07.12.2007, 14:33

Я так и планировал, чтобы был просто инструмент для загрузки, а не для библиотеки.
Библиотеку и так будет чем грузить. В общем расчитано на желающих попробывать функции или потестить.

Profan · 07.12.2007, 14:47

Для Кулик Алексей aka kpblc.
Зачем же ты сюда непроверенный код пихаешь?

Кулик Алексей aka kpblc · 07.12.2007, 14:57

Я не проверял только загрузку лиспов. Остальное проверено не раз и не два.

privodnik · 15.02.2018, 10:10

ребят, всю голову поломал, ну не силен я в лисп(
дайте, пожалуйста, код для загрузки из заранее прописанной папки(в теле лисп) с поиском lsp и vlx во всех вложенных.
вариант с обзором папок не нужен
спасибо!

----- добавлено через ~7 ч. -----
не надо, разобрался

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива	Profan	Готовые программы	272	06.06.2021 23:12
запуск программы из AutoCADа	kminas	Программирование	19	15.06.2012 13:42
Загрузка файлов Visual LISP в акад2006	Tserber	LISP	3	21.06.2006 12:00
загрузка DOS прог через LISP	Gaa	LISP	15	12.08.2005 19:19
VBA Поочередное открытие файлов DWG из нужной папки ???	sf	Программирование	7	21.03.2005 14:50

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск