Проникающая гидроизоляция бетона
Показать сообщение отдельно
Непрочитано 07.12.2007, 12:21 1 | #1
DwgRuLispLib: Команда. Загрузка lisp файлов из указанной папки
VVA
 
Инженер LISP
 
Минск
Регистрация: 11.05.2005
Сообщений: 6,784

Команда для загрузки лисп (*.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
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 29.04.2009 в 15:27.
Просмотров: 16639
 
Размещение рекламы