目录浏览对话框

marting

1. (defun _BrowseForFolder        (msg path / *error* acApp oShell oFolder)
   
2.   ;; Examples:
   
3.   ;; (_BrowseForFolder "Select a Folder" nil)
   
4.   ;; (_BrowseForFolder nil nil)
   
5.   ;; (_BrowseForFolder nil "C:\\users")
   
6.   (defun *error* (msg)
   
7.     (if        oShell
   
8.       (vlax-release-object oShell)
   
9.     )
   
10.     (cond ((not msg))                        ; Normal exit
    
11.           ((member msg '("Function cancelled" "quit / exit abort")))
    
12.                                         ; <esc> or (quit)
    
13.           ((princ (strcat "\n** Error: " msg " ** ")))
    
14.                                         ; Fatal error, display it
    
15.     )
    
16.     (if        oFolder
    
17.       path
    
18.       nil
    
19.     )
    
20.   )
    
21.   (and (or (and (= 'STR (type path)) (findfile path))
    
22.            (setq path (+ 1 64 256))
    
23.        )
    
24.        (or (= 'STR (type msg))
    
25.            (setq msg "Select a Folder to Search")
    
26.        )
    
27.        (setq acApp (vlax-get-acad-object))
    
28.        (setq oShell (vla-getinterfaceobject acApp "Shell.Application"))
    
29.        (setq oFolder (vlax-invoke
    
30.                        oShell
    
31.                        'BrowseForFolder
    
32.                        (vla-get-hwnd acApp)
    
33.                        msg
    
34.                        0
    
35.                        path
    
36.                      )
    
37.        )
    
38.        (setq
    
39.          path (vlax-get-property (vlax-get-property oFolder 'Self) 'Path)
    
40.        )
    
41.   )
    
42.   (*error* nil)
    
43. )
    

(defun _BrowseForFolder        (msg path / *error* acApp oShell oFolder)<br />   ;; Examples:<br />   ;; (_BrowseForFolder "Select a Folder" nil)<br />   ;; (_BrowseForFolder nil nil)<br />   ;; (_BrowseForFolder nil "C:\\users")<br />   (defun *error* (msg)<br />     (if        oShell<br />       (vlax-release-object oShell)<br />     )<br />     (cond ((not msg))                        ; Normal exit<br />           ((member msg '("Function cancelled" "quit / exit abort")))<br />                                         ; <esc> or (quit)<br />           ((princ (strcat "\n** Error: " msg " ** ")))<br />                                         ; Fatal error, display it<br />     )<br />     (if        oFolder<br />       path<br />       nil<br />     )<br />   )<br />   (and (or (and (= 'STR (type path)) (findfile path))<br />            (setq path (+ 1 64 256))<br />        )<br />        (or (= 'STR (type msg))<br />            (setq msg "Select a Folder to Search")<br />        )<br />        (setq acApp (vlax-get-acad-object))<br />        (setq oShell (vla-getinterfaceobject acApp "Shell.Application"))<br />        (setq oFolder (vlax-invoke<br />                        oShell<br />                        'BrowseForFolder<br />                        (vla-get-hwnd acApp)<br />                        msg<br />                        0<br />                        path<br />                      )<br />        )<br />        (setq<br />          path (vlax-get-property (vlax-get-property oFolder 'Self) 'Path)<br />        )<br />   )<br />   (*error* nil)<br /> )<br />

sicky111

沙发，谢谢分享。

yangjian001

谢谢l楼主的分享

liunian0524

感谢楼主分享