[VLISP程序]：利用Windows对话框一次获取多个文件

狂刀 · 发表于 2005-10-9 20:04:17

wkai，下载这个并安装试试看

afeng0712 · 发表于 2005-10-9 21:01:05

(defun getfiles (msg wl / x)
(vl-load-com)
(if (vlax-create-object "mscomdlg.commondialog")
(vl-registry-write
"HKEY_CLASSES_ROOT\\LICENSES\\4d553650-6abe-11cf-8adb-00aa00c00905"
""
"gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj"
)
)
(if (setq x (vlax-create-object "mscomdlg.commondialog"))
(progn
(if (not path)
(setq path "")
)
(vlax-put-property x "dialogtitle" msg)
(vlax-put-property x "filename" wl)
(vlax-put-property x "filter" wl)
(vlax-put-property x "initdir" path)
(vlax-put-property x "maxfilesize" 10000)
;; in lisp unbedingt notwendig, sonst kommt ne ;;fehlermeldung von wegen zu wenig speicher
(vlax-put-property x "flags" 512)
(vlax-put-property x "action" 1) ;_ showopen-dialog
(setq erg (vlax-get-property x "filename"))
)
)
(if (and erg (/= erg wl))
(setq erg (sttolst erg))
(setq erg nil)
)
)
(defun sttolst (str / f f2 lst i)
(setq i 1)
(setq f2 "")
(while (/= (setq f (substr str i 1)) "")
(if (= f " ")
(progn
(setq lst (append lst (list f2)))
(setq f2 "")
)
(setq f2 (strcat f2 f))
)
(setq i (1+ i))
)
(setq lst (append lst (list f2)))
)
;;调用命令：(getfiles "选择需要批处理打印的文件" "*.plt")

(defun getfiles        (msg wl / x) 
  (vl-load-com) 
  (if  (vlax-create-object "mscomdlg.commondialog") 
     (vl-registry-write 
       "HKEY_CLASSES_ROOT\\LICENSES\\4d553650-6abe-11cf-8adb-00aa00c00905" 
       "" 
       "gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj" 
     ) 
  ) 
  (if (setq x (vlax-create-object "mscomdlg.commondialog")) 
    (progn 
      (if (not path) 
        (setq path "") 
      ) 
      (vlax-put-property x "dialogtitle" msg) 
      (vlax-put-property x "filename" wl) 
      (vlax-put-property x "filter" wl) 
      (vlax-put-property x "initdir" path) 
      (vlax-put-property x "maxfilesize" 10000) 
      ;; in lisp unbedingt notwendig, sonst kommt ne  ;;fehlermeldung von wegen zu wenig speicher 
      (vlax-put-property x "flags" 512) 
      (vlax-put-property x "action" 1) ;_ showopen-dialog 
      (setq erg (vlax-get-property x "filename")) 
    ) 
  ) 
  (if (and erg (/= erg wl)) 
    (setq erg (sttolst erg)) 
    (setq erg nil) 
  ) 
) 
 
(defun sttolst (str / f f2 lst i) 
  (setq i 1) 
  (setq f2 "") 
  (while (/= (setq f (substr str i 1)) "") 
    (if        (= f " ") 
      (progn 
        (setq lst (append lst (list f2))) 
        (setq f2 "") 
      ) 
      (setq f2 (strcat f2 f)) 
    ) 
    (setq i (1+ i)) 
  ) 
  (setq lst (append lst (list f2))) 
) 
 
;;调用命令：(getfiles "选择需要批处理打印的文件" "*.plt")

狂刀 · 发表于 2005-10-9 21:33:01

(IF (= F " ")....
文件名和目录名都可能含有空格的！

wkai · 发表于 2005-10-9 22:15:37

狂刀：
下载了! regsvr了! reg了! 可以了！

afeng0712 · 发表于 2005-10-10 12:31:43

18楼的，这种情况怎么考虑比较好？

aeo · 发表于 2005-10-10 22:46:55

不管怎么用，首先得有那个文件才行.vb5或者vb6.

导入reg就相当于你是开发者了,(相当于你已经花钱买过vb了,号码各不相同.或装个vb就可以)
但不可能要求没个人都是开发者,那就reg一下.

如果没reg，可以要一个lpk认证.(使用者),就是这里说的:
http://support.microsoft.com/default.aspx?kbid=159923

afeng0712 · 发表于 2005-10-11 12:44:31

想问下楼上的，为什么这里对话框会跟网页-------（如何在 Internet Explorer 中使用授权的 ActiveX 控件）有关系？

橄榄滋味 · 发表于 2006-5-12 10:00:45

请问这个"HKEY_CLASSES_ROOT\\LICENSES\\4d553650-6abe-11cf-8adb-00aa00c00905"与(setq x (vlax-create-object "MSComDlg.CommonDialog"))有什么关系，为什么对二楼写的 (setq x (vlax-create-object "UserAccounts.CommonDialog"))不起作用，从表面上真看不出来，有谁知道，帮忙解释解释

eachy · 发表于 2006-5-13 09:51:41

看 10楼的链接，MS 的一些免费 ActiveX 控件是需要授权才可以使用的

oyxx_1023 · 发表于 2006-11-2 13:23:11

能不能实现像CAD自身的那种选择文件的对话框?
这个总感觉有点难受似的.
要选择驱动器,要选目录,对话框的大小也不能调整.

wujimmy · 发表于 2007-6-17 10:02:30

;; Register ActiveX server (dll/ocx)
;;
;; This requires RegSvr32.exe to be on the DOS path

(defun RegServer (server)
(startapp
   "regsvr32.exe"
   (strcat "/s \"" server "\"")
)
)

;; Get CLSID from ProgID

(defun GetClassID (ProgID)
(vl-registry-read
   (strcat "HKEY_CLASSES_ROOT\\" progid "\\CLSID")
)
)

;; Register hello ActiveX services,
;; if not already registered.

(defun Register (  / server)
(cond
   (  (GetClassID *hello*))
   (  (not (setq server (findfile "comdlg32.ocx")))
      (alert "Error: Can't locate hello Library (comdlg32.ocx)"))
   (t (regserver server)
      (or
         (GetClassID *hello*)
         (alert "Error: Failed to register hello ActiveX services.")
      )
   )
)
)

;;自动注册模块结束.
(setq *hello* "comdlg32.ocx")
(Register)

橄榄滋味 · 发表于 2007-9-21 09:54:59

能不能实现像CAD自身的那种选择文件的对话框?AutoCAD2002自带的那个批处理打印文件的选择文件对话框就很好，有谁能做到吗？这个总感觉有点难受似的，怪怪的，不能调整对话框的大小，我曾经将flags设为别的值，虽然对话框比较好看，也可以调整对话框的上下方向大小，但是不能支持多选，请教斑竹

hbgsw · 发表于 2008-7-30 18:23:43

写的太深奥拉.......

lukern · 发表于 2009-5-15 15:42:19

还不如使用getfiled函数,同样达到目的,且没有那些控件注册问题

paladi · 发表于 2009-8-18 14:16:53

请问是连续框选连续打印吗？

账号		自动登录	找回密码
密码			立即注册