- ;; 本代码仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊
- ;; 用途之适应性, 以及商业销售所隐含作出的保证, 在此一概予以否认.
- ;; ==================================================================
- ;; 作者:秋枫,参考了灯火的VBA程序
- ;; 用法:(qf_getFolder msg)
- ;; 例子:(qf_getFolder "选择文件夹:")
- ;; 返回值:字符串,文件夹路径,如果点了cancel, 返回nil
- (defun qf_getFolder (msg / WinShell shFolder path catchit)
- (vl-load-com)
- (setq winshell (vlax-create-object "Shell.Application"))
- (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
- (setq
- catchit (vl-catch-all-apply
- '(lambda ()
- (setq shFolder (vlax-get-property shFolder 'self))
- (setq path (vlax-get-property shFolder 'path))
- )
- )
- )
- (if (vl-catch-all-error-p catchit)
- nil
- path
- )
- )
|