如何把某一文件夹下的所有DWG文件自动转换为DXF文件,用lisp怎样实现?

Firebat

如题

meflying

VLISP的，这个是要在程序中打开文件并自动关闭。如果要不打开文件，则会复杂些。。。

2. 
   
3. (vl-load-com)
   
4. ;函数:GetFolder
   
5. ;功能:调用Windows通用目录选取对话框,返回选中路径
   
6. ;参数: msg-对话框提示字符串
   
7. 
   
8. (defun GetFolder (msg / WinShell shFolder path catchit)
   
9.   (vl-load-com)
   
10.   (setq winshell (vlax-create-object "Shell.Application"))
    
11.   (setq
    
12.     shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)
    
13.   )
    
14.   (setq
    
15.     catchit (vl-catch-all-apply
    
16.               '(lambda ()
    
17.                  (setq shFolder (vlax-get-property shFolder 'self))
    
18.                  (setq path (vlax-get-property shFolder 'path))
    
19.                )
    
20.             )
    
21.   )
    
22.   (if (vl-catch-all-error-p catchit)
    
23.     nil
    
24.     path
    
25.   )
    
26. )
    
27. 
    
28. (defun c:Tran( / Docs doc files file path i sset)
    
29.   (setq Docs (vla-get-documents (vlax-get-acad-object)))
    
30.   (setq path (GetFolder "选择文件夹"))
    
31.   (setq files (vl-directory-files path "*.dwg" 1))
    
32.   (setq sset (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
    
33.   (setq i 0)
    
34.   (repeat (length files)
    
35.     (setq file (nth i files))
    
36.     (setq doc (vla-open docs (strcat path "\" file)))
    
37.     (vla-export doc (strcat path "\" file) "DXF" sset)
    
38.     (vla-close doc)
    
39.     (vlax-release-object doc)
    
40.     (setq i (1+ i))
    
41.   )
    
42.   (vlax-release-object sset)
    
43.   (vlax-release-object docs)
    
44.   (princ)
    
45. )

<br /> (vl-load-com)<br /> ;函数:GetFolder<br /> ;功能:调用Windows通用目录选取对话框,返回选中路径<br /> ;参数: msg-对话框提示字符串<br /> <br /> (defun GetFolder (msg / WinShell shFolder path catchit)<br />   (vl-load-com)<br />   (setq winshell (vlax-create-object "Shell.Application"))<br />   (setq<br />     shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)<br />   )<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 /> )<br /> <br /> (defun c:Tran( / Docs doc files file path i sset)<br />   (setq Docs (vla-get-documents (vlax-get-acad-object)))<br />   (setq path (GetFolder "选择文件夹"))<br />   (setq files (vl-directory-files path "*.dwg" 1))<br />   (setq sset (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))<br />   (setq i 0)<br />   (repeat (length files)<br />     (setq file (nth i files))<br />     (setq doc (vla-open docs (strcat path "\" file)))<br />     (vla-export doc (strcat path "\" file) "DXF" sset)<br />     (vla-close doc)<br />     (vlax-release-object doc)<br />     (setq i (1+ i))<br />   )<br />   (vlax-release-object sset)<br />   (vlax-release-object docs)<br />   (princ)<br /> )

Firebat

非常感谢meflying超级版主的解答,谢谢了.

deepmoon

to MeFlying:
看了你的程式,開究了一下VL,請教些問題.
可以用VL控制用vla-open打開的圖檔的行為嗎?如視圖控制,圖層控制等.
好象用vla-open,再用vla-activate,程式就停住了.
另可不可以用VL不打開圖檔,即不顯示圖形,只查尋圖形數據庫內的東西.

meflying

我用的就是vla-open啊
你不能使用vla-activate，必须使用activeX直接去访问它。
如果不打开图形，要用ObjectDBX，等我做一下

meflying

2. 
   
3. (vl-load-com)
   
4. ;函数:GetFolder
   
5. ;功能:调用Windows通用目录选取对话框,返回选中路径
   
6. ;参数: msg-对话框提示字符串
   
7. (defun GetFolder (msg / WinShell shFolder path catchit)
   
8.   (vl-load-com)
   
9.   (setq winshell (vlax-create-object "Shell.Application"))
   
10.   (setq
    
11.     shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)
    
12.   )
    
13.   (setq
    
14.     catchit (vl-catch-all-apply
    
15.               '(lambda ()
    
16.                  (setq shFolder (vlax-get-property shFolder 'self))
    
17.                  (setq path (vlax-get-property shFolder 'path))
    
18.                )
    
19.             )
    
20.   )
    
21.   (if (vl-catch-all-error-p catchit)
    
22.     nil
    
23.     path
    
24.   )
    
25. )
    
26. 
    
27. (defun REGISTEROBJECTDBX (/ DBXSERVER)        ;by Tony Tanzillo
    
28.   (cond
    
29.     ((vl-registry-read
    
30.        "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
    
31.      )
    
32.     )
    
33.     ((not (setq DBXSERVER (findfile "AxDb15.dll")))
    
34.      (alert "Error: Can't locate ObjectDBX Library (AxDb15.dll)")
    
35.     )
    
36.     (t
    
37.      (startapp "regsvr32.exe" (strcat "/s "" DBXSERVER """))
    
38.      (or
    
39.        (vl-registry-read
    
40.          "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
    
41.        )
    
42.        (alert
    
43.          "Error: Failed to register ObjectDBX ActiveX services."
    
44.        )
    
45.      )
    
46.     )
    
47.   )
    
48. )
    
49. 
    
50. (defun Main(DOC DwgName sset / App DOC DBXDOC NAME1)
    
51.   (if (= "15" (substr (getvar "acadver") 1 2))
    
52.     (progn
    
53.       (if (not (REGISTEROBJECTDBX))
    
54.         (exit)       
    
55.       )
    
56.       (setq
    
57.         DBXDOC (vla-getinterfaceobject APP "ObjectDBX.AxDbDocument")
    
58.       )
    
59.     )
    
60.     (setq
    
61.       DBXDOC (vla-getinterfaceobject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.16")
    
62.     )
    
63.   )
    
64.   (setq NAME1 (strcat (getvar "dwgprefix") (getvar "dwgname")))
    
65.   (if (= NAME1 DwgName)
    
66.     (Wl-DXFOut DOC DwgName sset nil)
    
67.     (Wl-DXFOut DBXDOC DwgName sset t)
    
68.   )
    
69.   (vlax-release-object DBXDOC)
    
70. )
    
71. 
    
72. (defun Wl-DXFOut(DOC filename sset flags / )
    
73.   (if Flags
    
74.     (progn
    
75.       (vla-open DOC filename)
    
76.       (vlax-invoke-method DOC 'DXFOut (strcat (substr filename 1 (- (strlen filename) 4)) ".dxf"))
    
77.     )
    
78.     (vla-export DOC (substr filename 1 (- (strlen filename) 4)) "DXF" sset)
    
79.   )
    
80.   
    
81. )
    
82. 
    
83. (defun c:Tran( / Docs doc files file path i sset)
    
84.   (setq Doc (vla-get-activedocument (vlax-get-acad-object)))
    
85.   (setq path (GetFolder "选择文件夹"))
    
86.   (if (not path)
    
87.     (exit)
    
88.   )
    
89.   (setq files (vl-directory-files path "*.dwg" 1))
    
90.   (setq sset (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
    
91.   (setq i 0)
    
92.   (repeat (length files)
    
93.     (setq file (nth i files))
    
94.     (main Doc (strcat path "\" file) sset)
    
95.     (setq i (1+ i))
    
96.   )
    
97.   (vlax-release-object sset)
    
98.   (vlax-release-object doc)
    
99.   (princ)
    
100. )
     

<br /> (vl-load-com)<br /> ;函数:GetFolder<br /> ;功能:调用Windows通用目录选取对话框,返回选中路径<br /> ;参数: msg-对话框提示字符串<br /> (defun GetFolder (msg / WinShell shFolder path catchit)<br />   (vl-load-com)<br />   (setq winshell (vlax-create-object "Shell.Application"))<br />   (setq<br />     shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)<br />   )<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 /> )<br /> <br /> (defun REGISTEROBJECTDBX (/ DBXSERVER)        ;by Tony Tanzillo <br />   (cond<br />     ((vl-registry-read<br />        "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"<br />      )<br />     )<br />     ((not (setq DBXSERVER (findfile "AxDb15.dll")))<br />      (alert "Error: Can't locate ObjectDBX Library (AxDb15.dll)")<br />     )<br />     (t<br />      (startapp "regsvr32.exe" (strcat "/s "" DBXSERVER """))<br />      (or<br />        (vl-registry-read<br />          "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"<br />        )<br />        (alert<br />          "Error: Failed to register ObjectDBX ActiveX services."<br />        )<br />      )<br />     )<br />   )<br /> )<br /> <br /> (defun Main(DOC DwgName sset / App DOC DBXDOC NAME1)<br />   (if (= "15" (substr (getvar "acadver") 1 2))<br />     (progn<br />       (if (not (REGISTEROBJECTDBX))<br />         (exit)        <br />       )<br />       (setq<br />         DBXDOC (vla-getinterfaceobject APP "ObjectDBX.AxDbDocument")<br />       )<br />     )<br />     (setq<br />       DBXDOC (vla-getinterfaceobject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.16")<br />     )<br />   )<br />   (setq NAME1 (strcat (getvar "dwgprefix") (getvar "dwgname")))<br />   (if (= NAME1 DwgName)<br />     (Wl-DXFOut DOC DwgName sset nil)<br />     (Wl-DXFOut DBXDOC DwgName sset t)<br />   )<br />   (vlax-release-object DBXDOC)<br /> )<br /> <br /> (defun Wl-DXFOut(DOC filename sset flags / )<br />   (if Flags<br />     (progn<br />       (vla-open DOC filename)<br />       (vlax-invoke-method DOC 'DXFOut (strcat (substr filename 1 (- (strlen filename) 4)) ".dxf"))<br />     )<br />     (vla-export DOC (substr filename 1 (- (strlen filename) 4)) "DXF" sset)<br />   )<br />   <br /> )<br /> <br /> (defun c:Tran( / Docs doc files file path i sset)<br />   (setq Doc (vla-get-activedocument (vlax-get-acad-object)))<br />   (setq path (GetFolder "选择文件夹"))<br />   (if (not path)<br />     (exit)<br />   )<br />   (setq files (vl-directory-files path "*.dwg" 1))<br />   (setq sset (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))<br />   (setq i 0)<br />   (repeat (length files)<br />     (setq file (nth i files))<br />     (main Doc (strcat path "\" file) sset)<br />     (setq i (1+ i))<br />   )<br />   (vlax-release-object sset)<br />   (vlax-release-object doc)<br />   (princ)<br /> )<br />

deepmoon

呵呵,你真快,多謝多謝.
看來我又得在DBX方面補補課了!

wb0815

报告斑竹好像不太好使呀

meflying

这说明程序好使，这个错误是程序控制的出错信息。
可能你的CA安装不完全，我在2004和2000下都试了，还有98系统下的...
不过98下的对话框不好使，可以改用别的方法

jxphklibin

meflying，强！！！