选择目录对话框

Lisphk

1. ; msg - [sTR] - optional prompt message
   
2. ; defpath - [sTR] - optional default path
   
3. ; newfolderopt [T/nil] - T = display option to create new folder, else don't
   
4. ; Examples: (GetFolder nil nil nil) ; (GetFolder "Hello world" "D:\\GAMES" T)
   
5. (defun GetFolder
   
6.        (msg defpath newfolderopt / shell folder parentfolder path)
   
7.   (vl-catch-all-apply
   
8.     (function
   
9.       (lambda nil
   
10.         (setq shell (vlax-get-or-create-object "Shell.Application"))
    
11.         (setq folder
    
12.                (vlax-invoke-method
    
13.                  shell
    
14.                  'BrowseForFolder
    
15.                  0
    
16.                  (cond (msg)
    
17.                        ("")
    
18.                  )
    
19.                  (if newfolderopt
    
20.                    0
    
21.                    512
    
22.                  )
    
23.                  (cond (defpath)
    
24.                        ((strcat (getenv "userprofile") "\\Desktop\\"))
    
25.                  )
    
26.                )
    
27.         )
    
28.         (setq parentfolder (vlax-get-property folder 'ParentFolder))
    
29.         (setq path (vlax-get-property
    
30.                      (vlax-invoke-method
    
31.                        parentfolder
    
32.                        'Parsename
    
33.                        (vlax-get-property folder 'Title)
    
34.                      )
    
35.                      'Path
    
36.                    )
    
37.         )
    
38.       )
    
39.     )
    
40.   )
    
41.   (foreach x (reverse (list shell folder parentfolder path))
    
42.     (vl-catch-all-apply 'vlax-release-object (list x))
    
43.   )
    
44.   path
    
45. ) ; defun GetFolder
    

; msg - [sTR] - optional prompt message<br /> ; defpath - [sTR] - optional default path<br /> ; newfolderopt [T/nil] - T = display option to create new folder, else don't<br /> ; Examples: (GetFolder nil nil nil) ; (GetFolder "Hello world" "D:\\GAMES" T)<br /> (defun GetFolder<br />        (msg defpath newfolderopt / shell folder parentfolder path)<br />   (vl-catch-all-apply<br />     (function<br />       (lambda nil<br />         (setq shell (vlax-get-or-create-object "Shell.Application"))<br />         (setq folder<br />                (vlax-invoke-method<br />                  shell<br />                  'BrowseForFolder<br />                  0<br />                  (cond (msg)<br />                        ("")<br />                  )<br />                  (if newfolderopt<br />                    0<br />                    512<br />                  )<br />                  (cond (defpath)<br />                        ((strcat (getenv "userprofile") "\\Desktop\\"))<br />                  )<br />                )<br />         )<br />         (setq parentfolder (vlax-get-property folder 'ParentFolder))<br />         (setq path (vlax-get-property<br />                      (vlax-invoke-method<br />                        parentfolder<br />                        'Parsename<br />                        (vlax-get-property folder 'Title)<br />                      )<br />                      'Path<br />                    )<br />         )<br />       )<br />     )<br />   )<br />   (foreach x (reverse (list shell folder parentfolder path))<br />     (vl-catch-all-apply 'vlax-release-object (list x))<br />   )<br />   path<br /> ) ; defun GetFolder<br />

konglong604

谢谢您的分享，这个功能很有用。

xinrstar

marting

如果安装了EXPRESS，可以用这个

1. (acet-ui-pickdir)

(acet-ui-pickdir)

zjy2999

谢谢您的分享

kqqt6236

这个函数不错。