如何把某一文件夹下的所有DWG文件自动转换为DXF文件,用lisp怎样实现?
如题 VLISP的，这个是要在程序中打开文件并自动关闭。如果要不打开文件，则会复杂些。。。(vl-load-com)
;函数:GetFolder
;功能:调用Windows通用目录选取对话框,返回选中路径
;参数: msg-对话框提示字符串
(defun GetFolder (msg / WinShell shFolder path catchit)
(vl-load-com)
(setq winshell (vlax-create-object "Shell.Application"))
(setq
shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)
)
(setq
catchit (vl-catch-all-apply
'(lambda ()
(setq shFolder (vlax-get-property shFolder 'self))
(setq path (vlax-get-property shFolder 'path))
)
)
)
(if (vl-catch-all-error-p catchit)
nil
path
)
)
(defun c:Tran( / Docs doc files file path i sset)
(setq Docs (vla-get-documents (vlax-get-acad-object)))
(setq path (GetFolder "选择文件夹"))
(setq files (vl-directory-files path "*.dwg" 1))
(setq sset (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
(setq i 0)
(repeat (length files)
(setq file (nth i files))
(setq doc (vla-open docs (strcat path "\\" file)))
(vla-export doc (strcat path "\\" file) "DXF" sset)
(vla-close doc)
(vlax-release-object doc)
(setq i (1+ i))
)
(vlax-release-object sset)
(vlax-release-object docs)
(princ)
) 非常感谢meflying超级版主的解答,谢谢了. to MeFlying:
看了你的程式,開究了一下VL,請教些問題.
可以用VL控制用vla-open打開的圖檔的行為嗎?如視圖控制,圖層控制等.
好象用vla-open,再用vla-activate,程式就停住了.
另可不可以用VL不打開圖檔,即不顯示圖形,只查尋圖形數據庫內的東西. 我用的就是vla-open啊
你不能使用vla-activate，必须使用activeX直接去访问它。
如果不打开图形，要用ObjectDBX，等我做一下
(vl-load-com)
;函数:GetFolder
;功能:调用Windows通用目录选取对话框,返回选中路径
;参数: msg-对话框提示字符串
(defun GetFolder (msg / WinShell shFolder path catchit)
(vl-load-com)
(setq winshell (vlax-create-object "Shell.Application"))
(setq
shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)
)
(setq
catchit (vl-catch-all-apply
'(lambda ()
(setq shFolder (vlax-get-property shFolder 'self))
(setq path (vlax-get-property shFolder 'path))
)
)
)
(if (vl-catch-all-error-p catchit)
nil
path
)
)
(defun REGISTEROBJECTDBX (/ DBXSERVER) ;by Tony Tanzillo
(cond
((vl-registry-read
"HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
)
)
((not (setq DBXSERVER (findfile "AxDb15.dll")))
(alert "Error: Can't locate ObjectDBX Library (AxDb15.dll)")
)
(t
(startapp "regsvr32.exe" (strcat "/s \"" DBXSERVER "\""))
(or
(vl-registry-read
"HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
)
(alert
"Error: Failed to register ObjectDBX ActiveX services."
)
)
)
)
)
(defun Main(DOC DwgName sset / App DOC DBXDOC NAME1)
(if (= "15" (substr (getvar "acadver") 1 2))
(progn
(if (not (REGISTEROBJECTDBX))
(exit)
)
(setq
DBXDOC (vla-getinterfaceobject APP "ObjectDBX.AxDbDocument")
)
)
(setq
DBXDOC (vla-getinterfaceobject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.16")
)
)
(setq NAME1 (strcat (getvar "dwgprefix") (getvar "dwgname")))
(if (= NAME1 DwgName)
(Wl-DXFOut DOC DwgName sset nil)
(Wl-DXFOut DBXDOC DwgName sset t)
)
(vlax-release-object DBXDOC)
)
(defun Wl-DXFOut(DOC filename sset flags / )
(if Flags
(progn
(vla-open DOC filename)
(vlax-invoke-method DOC 'DXFOut (strcat (substr filename 1 (- (strlen filename) 4)) ".dxf"))
)
(vla-export DOC (substr filename 1 (- (strlen filename) 4)) "DXF" sset)
)
)
(defun c:Tran( / Docs doc files file path i sset)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(setq path (GetFolder "选择文件夹"))
(if (not path)
(exit)
)
(setq files (vl-directory-files path "*.dwg" 1))
(setq sset (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
(setq i 0)
(repeat (length files)
(setq file (nth i files))
(main Doc (strcat path "\\" file) sset)
(setq i (1+ i))
)
(vlax-release-object sset)
(vlax-release-object doc)
(princ)
)
呵呵,你真快,多謝多謝.
看來我又得在DBX方面補補課了! 报告斑竹好像不太好使呀
这说明程序好使，这个错误是程序控制的出错信息。
可能你的CA安装不完全，我在2004和2000下都试了，还有98系统下的...
不过98下的对话框不好使，可以改用别的方法 <strong><font color="#ff0000">meflying，强！！！</font></strong>
页:
[1]
2