明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 6081|回复: 15

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

  [复制链接]
发表于 2004-1-4 19:14 | 显示全部楼层 |阅读模式
如题
发表于 2004-1-5 08:43 | 显示全部楼层
VLISP的,这个是要在程序中打开文件并自动关闭。如果要不打开文件,则会复杂些。。。

  1. (vl-load-com)
  2. ;函数:GetFolder
  3. ;功能:调用Windows通用目录选取对话框,返回选中路径
  4. ;参数: msg-对话框提示字符串

  5. (defun GetFolder (msg / WinShell shFolder path catchit)
  6.   (vl-load-com)
  7.   (setq winshell (vlax-create-object "Shell.Application"))
  8.   (setq
  9.     shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)
  10.   )
  11.   (setq
  12.     catchit (vl-catch-all-apply
  13.               '(lambda ()
  14.                  (setq shFolder (vlax-get-property shFolder 'self))
  15.                  (setq path (vlax-get-property shFolder 'path))
  16.                )
  17.             )
  18.   )
  19.   (if (vl-catch-all-error-p catchit)
  20.     nil
  21.     path
  22.   )
  23. )

  24. (defun c:Tran( / Docs doc files file path i sset)
  25.   (setq Docs (vla-get-documents (vlax-get-acad-object)))
  26.   (setq path (GetFolder "选择文件夹"))
  27.   (setq files (vl-directory-files path "*.dwg" 1))
  28.   (setq sset (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
  29.   (setq i 0)
  30.   (repeat (length files)
  31.     (setq file (nth i files))
  32.     (setq doc (vla-open docs (strcat path "\" file)))
  33.     (vla-export doc (strcat path "\" file) "DXF" sset)
  34.     (vla-close doc)
  35.     (vlax-release-object doc)
  36.     (setq i (1+ i))
  37.   )
  38.   (vlax-release-object sset)
  39.   (vlax-release-object docs)
  40.   (princ)
  41. )
 楼主| 发表于 2004-1-5 20:40 | 显示全部楼层
非常感谢meflying超级版主的解答,谢谢了.
发表于 2004-1-6 14:46 | 显示全部楼层
to MeFlying:
看了你的程式,開究了一下VL,請教些問題.
可以用VL控制用vla-open打開的圖檔的行為嗎?如視圖控制,圖層控制等.
好象用vla-open,再用vla-activate,程式就停住了.
另可不可以用VL不打開圖檔,即不顯示圖形,只查尋圖形數據庫內的東西.
发表于 2004-1-6 15:27 | 显示全部楼层
我用的就是vla-open啊
你不能使用vla-activate,必须使用activeX直接去访问它。
如果不打开图形,要用ObjectDBX,等我做一下
发表于 2004-1-6 16:06 | 显示全部楼层

  1. (vl-load-com)
  2. ;函数:GetFolder
  3. ;功能:调用Windows通用目录选取对话框,返回选中路径
  4. ;参数: msg-对话框提示字符串
  5. (defun GetFolder (msg / WinShell shFolder path catchit)
  6.   (vl-load-com)
  7.   (setq winshell (vlax-create-object "Shell.Application"))
  8.   (setq
  9.     shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)
  10.   )
  11.   (setq
  12.     catchit (vl-catch-all-apply
  13.               '(lambda ()
  14.                  (setq shFolder (vlax-get-property shFolder 'self))
  15.                  (setq path (vlax-get-property shFolder 'path))
  16.                )
  17.             )
  18.   )
  19.   (if (vl-catch-all-error-p catchit)
  20.     nil
  21.     path
  22.   )
  23. )

  24. (defun REGISTEROBJECTDBX (/ DBXSERVER)        ;by Tony Tanzillo
  25.   (cond
  26.     ((vl-registry-read
  27.        "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
  28.      )
  29.     )
  30.     ((not (setq DBXSERVER (findfile "AxDb15.dll")))
  31.      (alert "Error: Can't locate ObjectDBX Library (AxDb15.dll)")
  32.     )
  33.     (t
  34.      (startapp "regsvr32.exe" (strcat "/s "" DBXSERVER """))
  35.      (or
  36.        (vl-registry-read
  37.          "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
  38.        )
  39.        (alert
  40.          "Error: Failed to register ObjectDBX ActiveX services."
  41.        )
  42.      )
  43.     )
  44.   )
  45. )

  46. (defun Main(DOC DwgName sset / App DOC DBXDOC NAME1)
  47.   (if (= "15" (substr (getvar "acadver") 1 2))
  48.     (progn
  49.       (if (not (REGISTEROBJECTDBX))
  50.         (exit)       
  51.       )
  52.       (setq
  53.         DBXDOC (vla-getinterfaceobject APP "ObjectDBX.AxDbDocument")
  54.       )
  55.     )
  56.     (setq
  57.       DBXDOC (vla-getinterfaceobject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.16")
  58.     )
  59.   )
  60.   (setq NAME1 (strcat (getvar "dwgprefix") (getvar "dwgname")))
  61.   (if (= NAME1 DwgName)
  62.     (Wl-DXFOut DOC DwgName sset nil)
  63.     (Wl-DXFOut DBXDOC DwgName sset t)
  64.   )
  65.   (vlax-release-object DBXDOC)
  66. )

  67. (defun Wl-DXFOut(DOC filename sset flags / )
  68.   (if Flags
  69.     (progn
  70.       (vla-open DOC filename)
  71.       (vlax-invoke-method DOC 'DXFOut (strcat (substr filename 1 (- (strlen filename) 4)) ".dxf"))
  72.     )
  73.     (vla-export DOC (substr filename 1 (- (strlen filename) 4)) "DXF" sset)
  74.   )
  75.   
  76. )

  77. (defun c:Tran( / Docs doc files file path i sset)
  78.   (setq Doc (vla-get-activedocument (vlax-get-acad-object)))
  79.   (setq path (GetFolder "选择文件夹"))
  80.   (if (not path)
  81.     (exit)
  82.   )
  83.   (setq files (vl-directory-files path "*.dwg" 1))
  84.   (setq sset (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
  85.   (setq i 0)
  86.   (repeat (length files)
  87.     (setq file (nth i files))
  88.     (main Doc (strcat path "\" file) sset)
  89.     (setq i (1+ i))
  90.   )
  91.   (vlax-release-object sset)
  92.   (vlax-release-object doc)
  93.   (princ)
  94. )
发表于 2004-1-6 16:40 | 显示全部楼层
呵呵,你真快,多謝多謝.
看來我又得在DBX方面補補課了!
发表于 2004-1-6 19:02 | 显示全部楼层
报告斑竹好像不太好使呀

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2004-1-6 22:00 | 显示全部楼层
这说明程序好使,这个错误是程序控制的出错信息。
可能你的CA安装不完全,我在2004和2000下都试了,还有98系统下的...
不过98下的对话框不好使,可以改用别的方法
发表于 2009-3-20 17:07 | 显示全部楼层
meflying,强!!!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-28 22:09 , Processed in 0.232306 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表