某一文件夹下的所有DWG文件自动转换为DXF文件

wgij007

之前有一贴，但出错。用CAD 2006，能帮改一下吗。
http://bbs.mjtd.com/forum.php?mo ... wg%2Bdxf&page=1

print1985

没装CAD2006 无法测试
我贴2种代码 你自己测试

(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.16\\CLSID"
     )
    )
    ((not (setq DBXSERVER (findfile "AxDb16.dll")))
     (alert "错误: 未能找到AxDb.dll文件")
    )
   
    (t
     (startapp "regsvr32.exe" (strcat "/s "" DBXSERVER """))
     (or
       (vl-registry-read
         "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument.16\\CLSID"
       )
       (alert
         "错误：注册失败"
       )
     )
    )
  )
)

(defun Main(DOC DwgName sset / App DOC DBXDOC NAME1)

  (if (= "16" (substr (getvar "acadver") 1 2))
    (progn
      (if (not (REGISTEROBJECTDBX))
        (exit)      
      )
      (setq
        DBXDOC (vla-getinterfaceobject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.16")
      )
    )
    (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)
)

print1985

代码2

(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 "AxDb16.dll")))
     (alert "错误: 未能找到AxDb.dll文件")
    )
   
    (t
     (startapp "regsvr32.exe" (strcat "/s "" DBXSERVER """))
     (or
       (vl-registry-read
         "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
       )
       (alert
         "错误：注册失败"
       )
     )
    )
  )
)

(defun Main(DOC DwgName sset / App DOC DBXDOC NAME1)

  (if (= "16" (substr (getvar "acadver") 1 2))
    (progn
      (if (not (REGISTEROBJECTDBX))
        (exit)      
      )
      (setq
        DBXDOC (vla-getinterfaceobject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
      )
    )
    (setq
      DBXDOC (vla-getinterfaceobject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
    )
  )
  (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)
)

print1985

以下我CAD2020可以用的代码，理论上CAD2007以上的其它版本对应替换代码里面的“23”为自己版本代号应该就可以了

(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.23\\CLSID"
     )
    )
    ((not (setq DBXSERVER (findfile "AxDb.dll")))
     (alert "错误: 未能找到AxDb.dll文件")
    )
   
    (t
     (startapp "regsvr32.exe" (strcat "/s "" DBXSERVER """))
     (or
       (vl-registry-read
         "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument.23\\CLSID"
       )
       (alert
         "错误：注册失败"
       )
     )
    )
  )
)

(defun Main(DOC DwgName sset / App DOC DBXDOC NAME1)

  (if (= "23" (substr (getvar "acadver") 1 2))
    (progn
      (if (not (REGISTEROBJECTDBX))
        (exit)      
      )
      (setq
        DBXDOC (vla-getinterfaceobject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.23")
      )
    )
    (setq
      DBXDOC (vla-getinterfaceobject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.23")
    )
  )
  (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)
)

print1985

AutoCAD 的版本号，代码里面的用的是整数部分（整数应该是表示大版本、主版本）

AutoCAD R14-1998.1
AutoCAD 2000  (R15.0)
AutoCAD 2000i (R15.1)
AutoCAD 2002  (R15.2)
AutoCAD 2004  (R16.0)
AutoCAD 2005  (R16.1)
AutoCAD 2006  (R16.2)
AutoCAD 2007  (R17.0)
AutoCAD 2008  (R17.1)
AutoCAD 2009  (R17.2)
AutoCAD 2010  (R18.0)
AutoCAD 2011  (R18.1)
AutoCAD 2012  (R18.2)
AutoCAD 2013  (R19.0)
AutoCAD 2014  (R19.1)
AutoCAD 2015  (R20.0)
AutoCAD 2016  (R20.1)
AutoCAD 2017  (R21.0)
AutoCAD 2018  (R22.0)
AutoCAD 2019  (R23.0)
AutoCAD 2020  (R23.1)

wgij007

print1985 发表于 2021-3-1 15:05
AutoCAD 的版本号，代码里面的用的是整数部分（整数应该是表示大版本、主版本）

AutoCAD R14-1998.1

第一个就可以了，感谢

panliang9

谢谢分享！

paulpipi

好东西，谢谢分享