Тема: функция запроса папки

Что-то не могу найти штатной функции запроса папки  :(
Пользуюсь пока этим -
(defun c:test ()
  (setq _f (getfiled "Выберите паку" "111" "111" 1))
  (setq _f (vl-filename-directory _f))
  (print _f)
(princ))
Нельзя ли как-то обходиться без имени файла при запросе выбора папки :?:

(изменено: Владимир Азарко, 23 августа 2010г. 14:12:44)

Re: функция запроса папки

Как вариант

 (defun Directory-Dia (Message / sh folder folderobject result)
    ;; By Tony Tanzillo
    ;; Modified by Tim Willey
    ;; 16 Will let you type in the path
    ;; 64 Will let you create a new folder
    ;; Use
    ;; (Directory-Dia "Create Sheet Index \nSelect directory to grab Drawings \nBy Tim Willey 09/13/07")

    (vl-load-com)
    (setq sh
       (vla-getInterfaceObject
         (vlax-get-acad-object)
         "Shell.Application"
       )
    )
    (setq folder
       (vlax-invoke-method
         sh
         'BrowseForFolder
         (vla-get-HWND (vlax-get-Acad-Object))
         Message
         0 ;;; This is the bit number to change.
               ;;; Вместо 0 можно попробовать (+ 16 64)
       )
    )
    (vlax-release-object sh)
    (if    folder
      (progn
    (setq folderobject
           (vlax-get-property folder 'Self)
    )
    (setq result
           (vlax-get-property FolderObject 'Path)
    )
    (vlax-release-object folder)
    (vlax-release-object FolderObject)
    (if (/= (substr result (strlen result)) "\\")
      (setq result (strcat result "\\"))
      result
    )
      )
    )
  )

Обращаю внимание, что вместо 0 можно попробовать биты 16 и (или) 64
16 - позволяет набирать путь
64 - позволяет создавать новую папку

(setq folder
      (vlax-invoke-method
        sh
        'BrowseForFolder
        (vla-get-HWND (vlax-get-Acad-Object))
        Message
        (+ 16 64) ;;; This is the bit number to change.
               ;;; Вместо 0 можно попробовать (+ 16 64)

      )
    )

(изменено: Yuriy, 23 августа 2010г. 22:33:53)

Re: функция запроса папки

Владимир, большое спасибо !!!
Код работает.
Единственный недостаток - нельзя изначально задать стартовую папку. Окно запроса всегда начинается с самого корня.

(изменено: Владимир Азарко, 25 августа 2010г. 14:34:28)

Re: функция запроса папки

Можно.
После красных строк из поста #2 идет необязательный параметр - папка по умолчанию. Для меня в нем есть один большой минус - нельзя выйти на уровень выше.
Допустим на диске D: есть папка TEMP

(setq ShlObj (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application")
        Folder (vlax-invoke-method ShlObj
                 'BrowseForFolder
                 (vla-get-HWND (vlax-get-Acad-Object))
                 ""
                 0
                 "D:\\TEMP"
                 )
        )
  (vlax-release-object ShlObj)

Если в этой папке есть файлы, то их можно показать

(setq ShlObj (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application")
        Folder (vlax-invoke-method ShlObj
                 'BrowseForFolder
                 (vla-get-HWND (vlax-get-Acad-Object))
                 ""
                 16384
                 "D:\\TEMP"
                 )
        )
  (vlax-release-object ShlObj)

почитай п. 3.18 описания BrowseForFolder

Синтаксис:
BrowseForFolder(<Hwnd>,<Заголовок>,<Опции>,<КорневаяПапка>)

Назначение: вызов модального окна "Выбор папки". Возвращает объект "Folder".

Параметры:
<Hwnd> - дескриптор родительского окна. Тип - целое число. 0 - текущее окно.
<Заголовок> - пояснение для пользователя в окне "Выбор папки". Тип - строка.
<Опции> - целое число (комбинация битовых флагов). Например, флаг 512 - запретить кнопку "Создать папку", 1 - не отображать Корзину, 16 - отображать EditBox для ввода полного пути с клавиатуры и т.п. Подробнее - см. MSDN.
<КорневаяПапка> - необязательный параметр. Корневая папка в окне "Выбор папки". Тип - строка. Пользователь не сможет пройти в окне "Выбор папки" выше этой папки. Если параметр не указан, корневой папкой будет рабочий стол Windows.

Re: функция запроса папки

Владимир, c папкой по умолчанию получилось.
Спасибо!!!