[密技]：使用标准vlisp显示选择文件夹对话框的方法：

秋枫

2. 
   
3. [FONT=courier new]
   
4. ;;; 本代码仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊
   
5. ;; 用途之适应性, 以及商业销售所隐含作出的保证, 在此一概予以否认.
   
6. ;; ==================================================================
   
7. ; 作者：秋枫，参考了灯火的VBA程序
   
8. ;; 用法：(qf_getFolder msg)
   
9. ;; 例子：(qf_getFolder "选择文件夹:")
   
10. ;; 返回值：字符串，文件夹路径，如果点了cancel, 返回nil
    
11. 
    
12. (defun qf_getFolder (msg / WinShell shFolder path catchit)
    
13.   (vl-load-com)
    
14.   (setq winshell (vlax-create-object "Shell.Application"))
    
15.   (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
    
16.   (setq
    
17.     catchit (vl-catch-all-apply
    
18.               '(lambda ()
    
19.                  (setq shFolder (vlax-get-property shFolder 'self))
    
20.                  (setq path (vlax-get-property shFolder 'path))
    
21.                )
    
22.             )
    
23.   )
    
24.   (if (vl-catch-all-error-p catchit)
    
25.     nil
    
26.     path
    
27.   )
    
28. )[/FONT]

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

前生

承教！实在是有些高.
上面的是显示文件对话框的方法。另有一个问题想请教：
    大体相当与DOSLIB中的(dos_serialno)功能的Vlisp方法有没有>?如有该怎么做呢?
谢谢!

秋枫

sorry, 我还没有用过doslib, 惭愧。能否说明一下dos_serialno的功能？

cy956

dos_serialno        dos_serialno        (dos_serialno [drive])  返回指定驱动器序列号    nil 失败
  Example
   (dos_serialno)                "8CD63F34"
   (dos_label "d:" "drive-d")        "8048A4CC"

前生

Cy956说的是,用途是取的硬盘的序列号

aeo

特别讨厌直接得到目录
比如R2002 的wblock,光选目录,也不知道文件夹里有没有同名文件.按顺序的话,还不知道已经到了哪.
要覆盖一个文件还特麻烦,还要把文件名一个字一个字的输入,能点到多好.

黄卫文

最初由 前生 发布
[B]承教！实在是有些高.
上面的是显示文件对话框的方法。另有一个问题想请教：
    大体相当与DOSLIB中的(dos_serialno)功能的Vlisp方法有没有>?如有该怎么做呢?
谢谢! [/B]

能否参考伊凡给的这个文件：）
http://www.xdcad.net/forum/showthread.php?s=&threadid=46526

LUCAS

2. 
   
3. ;;但它与(dos_serialno [drive])的值不同????
   
4. ;; By LUCAS(龙龙仔)
   
5. ;; FIND_SERIALNUMBER
   
6. ;; Returns of Drive SerialNumber
   
7. ;; Arguments [Typ]:
   
8. ;; Drive = "C:" [STR]
   
9. ;; Notes: Requires ScrRun.dll
   
10. ;; USAGE: (FIND_SERIALNUMBER "C:")
    
11. 
    
12. (defun FIND_SERIALNUMBER (DRIVE / FILSYS VAL)
    
13.   (setq FILSYS (vlax-create-object "Scripting.FileSystemObject"))
    
14.   (setq VAL (vlax-invoke FILSYS "GetDrive" DRIVE))
    
15.   (setq        VAL (vl-catch-all-apply
    
16.               'vlax-get
    
17.               (list VAL "SerialNumber")
    
18.             )
    
19.   )
    
20.   (vlax-release-object FILSYS)
    
21.   (if (vl-catch-all-error-p VAL)
    
22.     (setq VAL NIL)
    
23.     VAL
    
24.   )
    
25. )
    

<br /> ;;但它与(dos_serialno [drive])的值不同????<br /> ;; By LUCAS(龙龙仔)<br /> ;; FIND_SERIALNUMBER<br /> ;; Returns of Drive SerialNumber<br /> ;; Arguments [Typ]:<br /> ;; Drive = "C:" [STR]<br /> ;; Notes: Requires ScrRun.dll<br /> ;; USAGE: (FIND_SERIALNUMBER "C:")<br /> <br /> (defun FIND_SERIALNUMBER (DRIVE / FILSYS VAL)<br />   (setq FILSYS (vlax-create-object "Scripting.FileSystemObject"))<br />   (setq VAL (vlax-invoke FILSYS "GetDrive" DRIVE))<br />   (setq        VAL (vl-catch-all-apply<br />               'vlax-get<br />               (list VAL "SerialNumber")<br />             )<br />   )<br />   (vlax-release-object FILSYS)<br />   (if (vl-catch-all-error-p VAL)<br />     (setq VAL NIL)<br />     VAL<br />   )<br /> )<br />

前生

呵呵，是啊，在我的机器里c:的竟弄出了个负值.
不过真的很不错!

梦断江南

用标准的 AutoCAD 文件对话框提示用户输入一个文件名，并返回该文件名
(getfiled title default ext flags)

getfiled 函数显示一个对话框，其中包含指定类型（由扩展名指定）的有效文件名列表。用户可以浏览不同驱动器和目录中的文件，选择现有文件或指定新文件名。

参数

title

字符串，指定对话框的标签。

default

要使用的缺省文件名；可为空字符串 ("")。

ext

缺省的文件扩展名。如果 ext 为空字符串 ("")，则缺省值为 *（所有文件类型）。
如果该参数中包含 dwg 文件类型，则 getfiled 函数在对话框中显示预览图像框。

flags

整数（按位编码），控制对话框的行为。要一次设置多个条件，可以将几个位值加在一起生成一个 0 和 15 之间的标志值（包括 0 和 15）。getfiled 可识别下列 flags
参数：
1 （位 0）  提示输入新文件的名称。如果输入文件名是为了打开一个已存在的文件，请不要设置该位。因为在后面这种情况下，如果用户输入的是一个不存在的文件名，对话框将会在对话框的底部显示一条错误信息。
如果设置了该位而用户选择了一个已存在的文件，AutoCAD 会显示警告框，让用户选择继续进行或取消该操作。

4 （位 2）  允许用户输入任意文件扩展名，或者干脆不输入文件扩展名。
如果不设置该位，则 getfiled 仅接受 ext 参数中指定的扩展名，并在用户没有输入扩展名时自动给文件名加上该扩展名。
8 （位 3）  如果设置了该位而位 0 没有设置，getfiled 函数将在库搜索路径内搜索输入的文件名。如果在库搜索路径下发现了该文件，它将截去路径部分而仅返回文件名（但如果在另一个路径下也发现了同名的文件，它就不会截去路径部分）。

如果未设置该位， getfiled 返回包括据经在内的文件全名。
如果要用对话框打开现有文件，并想将其文件名存入图形文件（或其他数据库），就应该设置该位。
16 （位 4）  如果设置该位，或 default 参数以路径分割符结束，则该参数仅被解释为路径名。getfiled 寒暑假定不存在缺省文件名，并在“查找范围”框中显示路径，而在“文件名”框中不显示任何内容。
32 （位 5）  如果设置该位，且设置了位 0（已指定了新文件的名称），则如果用户要覆盖现有文件时，不会获得警告信息。即，不再出现提醒框提醒用户已存在同名文件，而是直接覆盖原来的文件。

64 （位 6）  即使如果用户指定了 URL，也不传输远程文件。
128（位 7）  不允许 URL。

返回值

如果对话框中包含用户指定的文件名，则 getfiled 返回指定文件名的字符串。否则该函数返回 nil。

实例:

命令: (getfiled "getfile" "" "" 4)
"D:\\AutoCAD 2002\\AcedInetActiveX.ocx" "D:\\AutoCAD 2002\\AcedInetActiveX.ocx"
[/COLOR]

橄榄滋味

用getfiled可以获得文件名，但是一次只能获得一个文件名，如何可以象在open对话框中一样，一次可以选择多个文档（autocad 2000版本以上），返回多个文档名称列表，然后再对它逐个操作呢？

雨箭风刀

已经有人做到了.你在本论坛或到明经cad搜索一下

蒹葭_Keirll

楼主的代码相当给力