DwgRuLispLib: получение списка файлов по маске с необязательной проверкой вложенных

Кулик Алексей aka kpblc · 14.01.2008, 10:46

Важно! Проход по вложенным каталогам опционален, поэтому скорость работы кода не очень велика.

Код:

;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * dwgru-browsefiles-in-directory
;;; *
;;; * 06/12/007 Версия 01.001.14.
;;; * 
;;; ************************************************************************
;;; исходник: http://www.caduser.ru/cgi-bin/f1/board.cgi?t=19612AN

(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 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

acyxou · 04.03.2009, 13:07

Подскажите пожалуйста, с помощью какой функции из выданного лиспом результата убрать путь к файлам? Или сделать чтоб лисп выдавал содержимое папки без указания путей к файлам, только названия файлов.

Кулик Алексей aka kpblc · 04.03.2009, 13:52

Например, так:

Код:

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

(mapcar (function (lambda(x)(strcat (vl-filename-base x) (vl-filename-extension x)))) (dwgru-browsefiles-in-directory path "*.lsp" t))

acyxou · 04.03.2009, 14:08

О, спасибо!

тока куда этот код пихать то? Ладно бы если исходник был бы с комментариями нормальными, мож бы еще и разобрался какой mapcar к чему относится... а тут ведь нет ничего почти... 5 mapcar'ов вроде, какой менять не пойму....

Кулик Алексей aka kpblc · 04.03.2009, 15:01

Что именно (и, самое главное, зачем) ты собираешься менять?

acyxou · 04.03.2009, 16:02

Отвечу на вопрос "Зачем я собираюсь менять?"
В организации есть куча принтеров (файлы .pc3) всяких разных, в том числе и виртуальных (pdf, dxf, jpg и т.д.). Я их рассортировал по папкам (основные, цветные, виртуальные и т.д.), написал небольшой лисп для смены Printer Configuration Search Path и кнопки к нему соответсвтенно (основные, цветные, виртуальные и т.д.). Так вот, когда пользователь выбирает себе принтеры, я хочу сделать чтоб в подтвержении его выбора выскакивало окошко типа "alert" где ему бы писалось какие принтеры он сейчас загрузил. Т.е. в alert'е высвечивались бы файлы *.pc3 из соответствующей папки. И чтоб вручную не вбивать в лисп содержимое папок, хочу чтоб это содержимое считывалось само.
Надеюсь понятно объяснил....

Вот мой лисп для смены Printer Configuration Search Path:

Код:

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

;;;Загрузка набора только цветных принтеров из папки "Plotters_colored"
(defun C:PP_COL	(/ server rel_path path)
  (setq server (strcat "\\\\Server\\Proekts\\AutoCAD_Resources"))
  (setq rel_path (strcat "\\Plotters\\Plotters_colored"))
  (setq path (strcat server rel_path))
  (vla-put-PrinterConfigPath
    (vla-get-files (vla-get-preferences (vlax-get-acad-object)))
    path
  )
  (setenv "HideSystemPrinters" "1")
  (alert
    "\nЦветные принтеры загружены:
    \n
    \EPSON Stylus Photo 830U Series.pc3
    \EPSON Stylus Photo R1800 Best Foto.pc3
    \EPSON Stylus Photo R1800.pc3")
  (princ)
)

Кулик Алексей aka kpblc · 04.03.2009, 16:24

Попробуй так:

Код:

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

(defun test (/ printer_type printer_lst base_path dwgru-browsefiles-in-directory)

;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * dwgru-browsefiles-in-directory
;;; *
;;; * 06/12/007 Версия 01.001.14.
;;; * 
;;; ************************************************************************
;;; исходник: http://www.caduser.ru/cgi-bin/f1/board.cgi?t=19612AN

  (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 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

  (setq base_path   "\\\\Server\\Proekts\\AutoCAD_Resources"
        printer_lst '(("Цветные"
                       ("eng" . "Colored")
                       ("key" . "C")
                       ("path" . "\\Plotters\\Plotters_colored")
                       )
                      ("Виртуальные"
                       ("eng" . "Virtual")
                       ("key" . "V")
                       ("path" . "\\Plotters\\Plotters_virtual")
                       )
                      ("Базовые"
                       ("eng" . "Based")
                       ("key" . "B")
                       ("path" . "\\Plotters\\Plotters_base")
                       )
                      )
        ) ;_ end of setq
  (initget (vl-string-trim " "
                           (strcat (apply 'strcat
                                          (mapcar
                                            '(lambda (x)
                                               (strcat (car x) " ")
                                               ) ;_ end of LAMBDA
                                            printer_lst
                                            ) ;_ end of mapcar
                                          ) ;_ end of apply
                                   (apply 'strcat
                                          (mapcar
                                            '(lambda (x)
                                               (strcat (cdr (assoc "eng" (cdr x))) " ")
                                               ) ;_ end of LAMBDA
                                            printer_lst
                                            ) ;_ end of mapcar
                                          ) ;_ end of apply
                                   "_ "
                                   (apply 'strcat
                                          (mapcar
                                            '(lambda (x)
                                               (strcat (cdr (assoc "key" (cdr x))) " ")
                                               ) ;_ end of LAMBDA
                                            printer_lst
                                            ) ;_ end of mapcar
                                          ) ;_ end of apply
                                   (apply 'strcat
                                          (mapcar
                                            '(lambda (x)
                                               (strcat (cdr (assoc "key" (cdr x))) " ")
                                               ) ;_ end of LAMBDA
                                            printer_lst
                                            ) ;_ end of mapcar
                                          ) ;_ end of apply
                                   ) ;_ end of strcat
                           ) ;_ end of vl-string-trim
           ) ;_ end of initget
  (if (= (type
           (setq printer_type (getkword
                                (strcat "\nВыберите принтеры ["
                                        (vl-string-trim "/"
                                                        (apply 'strcat
                                                               (mapcar
                                                                 '(lambda (x)
                                                                    (strcat (car x) "/")
                                                                    ) ;_ end of LAMBDA
                                                                 printer_lst
                                                                 ) ;_ end of mapcar
                                                               ) ;_ end of apply
                                                        ) ;_ end of VL-STRING-TRIM
                                        "] <Отмена> : "
                                        ) ;_ end of strcat
                                ) ;_ end of getkword
                 ) ;_ end of setq
           ) ;_ end of type
         'str
         ) ;_ end of =
    (progn
      (vla-put-printerconfigpath
        (vla-get-files (vla-get-preferences (vlax-get-acad-object)))
        (strcat base_path
                (cdr (assoc "path"
                            (setq printer_type (cdar (vl-remove-if-not
                                                       '(lambda (x)
                                                          (= (cdr (assoc "key" (cdr x))) printer_type)
                                                          ) ;_ end of lambda
                                                       printer_lst
                                                       ) ;_ end of vl-remove-if-not
                                                     ) ;_ end of cdar
                                  ) ;_ end of setq
                            ) ;_ end of assoc
                     ) ;_ end of cdr
                ) ;_ end of strcat
        ) ;_ end of vla-put-PrinterConfigPath
      (setenv "HideSystemPrinters" "1")
      (alert (strcat "Установлены "
                     (strcase (car printer_type) t)
                     "принтеры:"
                     (apply 'strcat
                            (mapcar
                              '(lambda (x)
                                 (strcase (strcat "\n" (vl-filename-base x) (vl-filename-extension x)))
                                 ) ;_ end of lambda
                              (dwgru-browsefiles-in-directory base_path "*.pc3" t)
                              ) ;_ end of mapcar
                            ) ;_ end of apply
                     ) ;_ end of strcat
             ) ;_ end of alert
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

Сам понимаешь, я код не проверял особо.

acyxou · 06.03.2009, 11:30

Многоуважаемый kpblc, спасибо за помощь, буду разбираться... Хочу еще спросить, для чего нужен апостроф (одинарная кавычка) в коде? Поиском пользовался и никак не могу найти, потому что наверно запрос коряво задаю... в акадовской справке тоже не нашел. Не могли бы ткнуть пальцем где почитать про это можно?

VVA · 06.03.2009, 13:01

acyxou, Если я правильно понял, то кавычка - это синоним функции лиспа quote:
(quote a) = 'a

alex8888 · 09.03.2010, 11:17

Что нужно добавить в этот Лисп, чтобы получить список файлов для последующей обработки, например, загрузке в память? А то на выходе получаем только список файлов в окне по F2 (не знаю, как оно называется в не немецком каде) и что делать дальше не дойду никак.

Кулик Алексей aka kpblc · 09.03.2010, 11:44

Вообще-то исходный лисп как раз и возвращает список файлов. Присваиваешь результат функции переменной и делай с ней чего хотишь

alex8888 · 09.03.2010, 12:11

Кулик Алексей aka kpblc

Цитата:

Присваиваешь результат функции переменной...

Можешь ткнуть пальцем, куда? Где сам процесс вывода, в смысле, в какой строке? Я запутался во всех if и lambda.

Кулик Алексей aka kpblc · 09.03.2010, 13:04

Код:

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

(setq lst (dwgru-browsefiles-in-directory "c:\\mydir" "*.lsp" t))

Или

Код:

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

(foreach file (dwgru-browsefiles-in-directory "c:\\mydir" "*.lsp" t)
(load file)
)

Вроде так.

alex8888 · 09.03.2010, 14:17

Кулик Алексей aka kpblc
Оказалось, проще не бывает

А я с дуру ума в саму программу хотел сунуться.

alex8888 · 18.03.2010, 16:49

Кулик Алексей aka kpblc,
почему в конструкции:

(defun at-load-lsp (/ lst file)
(setq lst (dwgru-browsefiles-in-directory "D:\\LISP" '("*.lsp" "*.Vlx" "*.fas") t))
(foreach file lst (load file))
)

возникает ошибка? Вот лог:

Befehl: (at-load-lsp)
Fehlerhafter Lesevorgang für Zeichen (Oktal): 0

Кулик Алексей aka kpblc · 19.03.2010, 01:56

Я по-немецки нихьть бельмес

Попробуй код, например, такой:

Код:

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

(defun at-load-lsp (/ lst)
(setq lst (dwgru-browsefiles-in-directory "D:\\LISP" '("*.lsp" "*.Vlx" "*.fas") t))
(foreach file lst (load file (strcat "Can't load " file))
)

Хотя я бы, наверное, сделал вот так:

Код:

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

(defun at-load-lsp( / err)
	(foreach file (dwgru-browsefiles-in-directory "D:\\LISP" '("*.lsp" "*.Vlx" "*.fas") t)
		(if (vl-catch-all-error-p
				(setq err (vl-catch-all-apply '(lambda() (load file)))))
			(princ (strcat "\nError loading file " file " : " (vl-catch-all-error-message err))))
		)
	)

Код писал без запущенного AutoCAD, так что его не помешает проверить.

alex8888 · 19.03.2010, 09:23

Кулик Алексей aka kpblc

Цитата:

Я по-немецки нихьть бельмес

Написанное мною переводится как
"Неправильное чтение символов (восьмеричное)"
А куда его засунуть? (Гусары, молчать!)
Такое ощущение, что в каком то файле ошибка и на нем программа затыкалась. Второй из твоих кодов запустил, тоже вылетали вышеуказанные ошибки (в основном из скачанных файлов, то есть не моих - скорее всего плохо адаптированных под фрицовский механикел), но файлы в память загрузились.
Теперь если в файл acaddoc.lsp прописать мою команду, то будут Лиспы грузиться при открытии любого чертежа, правильно? И как там прописать еще и загрузку dwgru-browsefiles-in-directory.lsp? Просто через
(load "<путь>:\\dwgru-browsefiles-in-directory.lsp") ?

Кулик Алексей aka kpblc · 19.03.2010, 09:47

Скорее всего, в каком-то из лиспом идет запрос на "непонятном" языке. Возможно, дополнительно еще и кодировка нарушена.
Попробуй посмотреть те файлы, которые выдают при загрузке ошибки. Их можно попытаться открыть, например, FAR'ом или Notepad++, скопировать содержимое, вызвать vlide в AutoCAD, создать новый файл и вставить туда. Потом только что созданный файл сохранить как lsp взамен старого.

Цитата:

Сообщение от alex8888

Теперь если в файл acaddoc.lsp прописать мою команду, то будут Лиспы грузиться при открытии любого чертежа, правильно?

По идее да.

Цитата:

Сообщение от alex8888

И как там прописать еще и загрузку dwgru-browsefiles-in-directory.lsp? Просто через
(load "<путь>:\\dwgru-browsefiles-in-directory.lsp") ?

Либо так, либо напрямую в acaddoc.lsp вставить код функции. И потом просто вызывать все что надо.
Хотя я бы задумывался о "прописывании" лиспа с dwgru-browsefiles-in-directory и лиспа с кодом загрузки в StartupSuite...

alex8888 · 19.03.2010, 10:14

Цитата:

StartupSuite.

Что за зверь? Где почитать? В справке Када нет.

Кулик Алексей aka kpblc · 19.03.2010, 11:04

Сначала команда _.appload, а потом:

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
DwgRuLispLib: Функция открытия диалога Open\Save As файла (файлов)	Supermax	Библиотека функций	20	14.03.2018 10:05
DwgRuLispLib: Команда. Загрузка lisp файлов из указанной папки	VVA	Библиотека функций	7	15.02.2018 10:10
Исключение элементов одного списка из другого по маске	Кулик Алексей aka kpblc	Программирование	3	18.09.2006 17:31