多文件选择函数

tryhi

;;多文件选择   BY:大海
;;参数1：标题
;;参数2：起始目录(找不到目录时打开上一次的目录)
;;参数3：文件类型 例如：图像文件 (*.jpg;*.bmp)|*.jpg;*.bmp
;;返回文件路径表
;;例子：(try-FileOpenDialog "选择文件" *Desktop* "图像文件 (*.jpg;*.bmp)|*.jpg;*.bmp")






虽说是lsp，但其实是调用了一个exe，exe的数据打包在lsp里面了，这个exe使用C语言写的，实现了用lsp直接进行多个文件的选择，返回的是所选择的文件完整路径表

highflybir

我这里提供一个无需用exe即可打开多个文件的LISP程序：

1. ;;;=============================================================
   
2. ;;; 通用文件对话框:                                             
   
3. ;;;=============================================================
   
4. (defun C:OpenFile (/ *SCR name code path)
   
5.   (or
   
6.     (setq *SCR (vlax-create-object "Aec32BitAppServer.AecScriptControl.1"))
   
7.     (setq *SCR (vlax-create-object "ScriptControl"))
   
8.   )
   
9.   (or
   
10.     (setq path (strcat (GetSpecialPath 0) "\\System32\\COMCTL32.OCX"))
    
11.     (setq path (strcat (GetSpecialPath 0) "\\SysWOW64\\COMCTL32.OCX"))
    
12.   )
    
13.   (if (and *SCR path)
    
14.     (progn
    
15.       (vlax-put *SCR 'language "VBScript")
    
16.       (setq code
    
17.             "Function GetDlg(InitDir,fileName,Filter)
    
18.               Set dlg = CreateObject(\"MSComDlg.CommonDialog\")
    
19.               dlg.InitDir = InitDir
    
20.             dlg.Flags = &H200
    
21.               dlg.fileName = fileName
    
22.             dlg.Filter = Filter
    
23.             dlg.MaxFileSize = 520
    
24.             'dlg.DialogTitle = \"打开文件对话框\"
    
25.             'dlg.Max = 520
    
26.             'dlg.DefaultExt = DefaultExt
    
27.             'dlg.Flags = 18
    
28.             dlg.ShowOpen
    
29.             GetDlg = dlg.fileName
    
30.             End Function"
    
31.       )
    
32.       (vlax-invoke *SCR 'addcode code)
    
33.       (setq name
    
34.         (vl-catch-all-apply
    
35.           'vlax-invoke
    
36.           (list
    
37.             *SCR 'run
    
38.             "GetDlg"
    
39.             ""
    
40.             ""
    
41.             "All files(*.*)|*.*|LISP 文件(*.lsp)|*.lsp"
    
42.           )
    
43.         )
    
44.       )
    
45.       (vlax-release-object *SCR)
    
46.       (if (not (vl-catch-all-error-p name))
    
47.         Name
    
48.       )
    
49.     )
    
50.   )
    
51. )
    
52. ;;;Get the system special path
    
53. (defun GetSpecialPath (n / fso path)
    
54.   (setq fso  (vlax-create-object "Scripting.FileSystemObject"))
    
55.   (setq path (vlax-get (vlax-invoke fso 'GetSpecialFolder n) 'path))
    
56.   (vlax-release-object fso)
    
57.   path
    
58. )
    
59. 
    

;;;=============================================================<br /> ;;; 通用文件对话框:                                             <br /> ;;;=============================================================<br /> (defun C:OpenFile (/ *SCR name code path)<br />   (or<br />     (setq *SCR (vlax-create-object "Aec32BitAppServer.AecScriptControl.1"))<br />     (setq *SCR (vlax-create-object "ScriptControl"))<br />   )<br />   (or <br />     (setq path (strcat (GetSpecialPath 0) "\\System32\\COMCTL32.OCX"))<br />     (setq path (strcat (GetSpecialPath 0) "\\SysWOW64\\COMCTL32.OCX"))<br />   )<br />   (if (and *SCR path)<br />     (progn<br />       (vlax-put *SCR 'language "VBScript")<br />       (setq code<br />             "Function GetDlg(InitDir,fileName,Filter)<br />               Set dlg = CreateObject(\"MSComDlg.CommonDialog\")<br />               dlg.InitDir = InitDir<br />             dlg.Flags = &H200<br />               dlg.fileName = fileName<br />             dlg.Filter = Filter<br />             dlg.MaxFileSize = 520<br />             'dlg.DialogTitle = \"打开文件对话框\"<br />             'dlg.Max = 520<br />             'dlg.DefaultExt = DefaultExt<br />             'dlg.Flags = 18<br />             dlg.ShowOpen <br />             GetDlg = dlg.fileName<br />             End Function"<br />       )<br />       (vlax-invoke *SCR 'addcode code)<br />       (setq name <br />         (vl-catch-all-apply<br />           'vlax-invoke<br />           (list<br />             *SCR 'run<br />             "GetDlg"<br />             ""<br />             ""<br />             "All files(*.*)|*.*|LISP 文件(*.lsp)|*.lsp"<br />           )<br />         )<br />       )<br />       (vlax-release-object *SCR)<br />       (if (not (vl-catch-all-error-p name))<br />         Name<br />       )<br />     )<br />   )<br /> )<br /> ;;;Get the system special path<br /> (defun GetSpecialPath (n / fso path)<br />   (setq fso  (vlax-create-object "Scripting.FileSystemObject"))<br />   (setq path (vlax-get (vlax-invoke fso 'GetSpecialFolder n) 'path))<br />   (vlax-release-object fso)<br />   path <br /> )<br /> <br />

如果读者想了解更多的方式，请参考我的附件。

MUSIC-DIE

highflybir 发表于 2021-5-16 14:33
我这里提供一个无需用exe即可打开多个文件的LISP程序：
如果读者想了解更多的方式，请参考我的附件。

(vlax-put *SCR 'language "VBScript")


这一句运行不成功怎么回事啊？    直接nil
*scr  是有的，是通过第一种方式创建的
64位WIN10  CAD 2012

xj6019

支持，谢谢大海老师分享！

言戲無軍

大海强大 竟然用c

言戲無軍

可以设置单选模式就好了 win10下getfile函数第一次选不中文件

雨的节奏

学习一下大海的写法。。。

tryhi

言戲無軍 发表于 2021-5-15 11:00
可以设置单选模式就好了 win10下getfile函数第一次选不中文件

是啊，第一次选择无效，这点确实挺烦的

言戲無軍

tryhi 发表于 2021-5-15 11:31
是啊，第一次选择无效，这点确实挺烦的

这个能解决第一次选择无效问题不

tryhi

highflybir 发表于 2021-5-16 14:33
我这里提供一个无需用exe即可打开多个文件的LISP程序：
如果读者想了解更多的方式，请参考我的附件。

不知道使用的要求的什么，OpenFile没有反应，只返回一个nil

highflybir

tryhi 发表于 2021-5-16 14:53
不知道使用的要求的什么，OpenFile没有反应，只返回一个nil

在我的机器上是能得到返回值的。
这个源码稍微改一下，就可以转成函数。