[求助]：想把下面的vba---〉vb

kileng

下面是我在vba里通过的，但是我到vb下时能打开却不能执行另存
Private Sub CommandButton1_Click()
Dim dwg As String
Dim fn As String
Dim fs As Object
Dim dxf As Object

dwg = Dir(TextBox1.Text & "\*.dwg")
Set fs = CreateObject("Scripting.FileSystemObject")
Set dxf = fs.createfolder(TextBox2.Text)

    ThisDrawing.Application.Documents.Open "" & TextBox1.Text & "\" & dwg & ""
    fn = Mid(dwg, 1, Len(dwg) - 4)
    'ThisDrawing.SaveAs "" & TextBox1.Text & "\" & "dxf" & "\" & fn & "", acR12_dxf
    ThisDrawing.SaveAs "" & dxf & "\" & fn & "", acR12_dxf
    ThisDrawing.Close

End Sub

'***********************************
'***********************************
'vb下我改为
Option Explicit
Private Sub Command1_Click()

Dim dwg As String
Dim fn As String
Dim fs As Object
Dim acadApp As Object
Dim acadDoc As Object

On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set acadApp = CreateObject("AutoCAD.Application")
If Err Then End
End If
acadApp.Visible = True
Set acadDoc = acadApp.ActiveDocument

On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set acadApp = CreateObject("AutoCAD.Application")
If Err Then End
End If
acadApp.Visible = True
Set acadDoc = acadApp.ActiveDocument
'*******************************************

dwg = Dir(Text1.Text & "\*.dwg")
'Set fs = CreateObject("Scripting.FileSystemObject")
'Set dxf = fs.creat
  
   acadDoc.Application.Documents.Open "" & Text1.Text & "\" & dwg & ""
   fn = Mid(dwg, 1, Len(dwg) - 4)
   acadDoc.SaveAs "" & Text1.Text & "\" & fn & "", acR12_dxf
   acadDoc.Close

End Sub
'*在acadDoc.SaveAs 好像没有反应，怎么改呢？
其实我想实现的就是dwg另存为dxf

efan2000

刚打开的文档并不是acadDoc，要重设一次当前文档，这一点与VBA中的ThisDrawing是有区别的。
acadDoc.Application.Documents.Open "" & Text1.Text & "\" & dwg & ""
Set acadDoc = acadApp.ActiveDocument
fn = Mid(dwg, 1, Len(dwg) - 4)
acadDoc.SaveAs "" & Text1.Text & "\" & fn & "", acR12_dxf
acadDoc.Close

kileng

最初由 kileng 发布
[B]下面是我在vba里通过的，但是我到vb下时能打开却不能执行另存
Private Sub CommandButton1_Click()
Dim dwg As String
Dim fn As String
Dim fs As Object
Dim dxf As Object

dwg = Dir(TextBox1.Text & "\*... [/B]

可以保存了
于是,我想设置一个循环,把路径文件夹下的dwg都转为dxf,但是程序只做了一个文件,我的循环有错吗?
dwg = Dir(Text1.Text & "\*.dwg")
  
Do While dwg <> ""
   acadDoc.Application.Documents.Open "" & Text1.Text & "\" & dwg & ""
   Set acadDoc = acadApp.ActiveDocument
   fn = Mid(dwg, 1, Len(dwg) - 4)
   acadDoc.SaveAs "" & Text1.Text & "\" & fn & "", acR12_dxf
   acadDoc.Close
     
   dwg = Dir
   
Loop
End

雪山飞狐(lzh)

用DBX做
Private Sub xl()
Dim objdbx As Object
Dim acadapp As Object
Set acadapp = GetObject(, "autocad.application.16")
Set objdbx = acadapp.GetInterfaceObject("ObjectDBX.AxDbDocument.16")
objdbx.Open "c:\2.dwg"
objdbx.DxfOut "c:\3.dxf"
set objdbx=nothing
End Sub

kileng

最初由 kileng 发布
[B][QUOTE]最初由 kileng 发布
[B]下面是我在vba里通过的，但是我到vb下时能打开却不能执行另存
Private Sub CommandButton1_Click()
Dim dwg As String
Dim fn As String
Dim fs As Object
Dim dxf As Ob... [/B]

DBX 是什么?!

雪山飞狐(lzh)

ObjectDBX有两种版本，一种是完全不需要AutoCAD，可单独运行，但它只能通过VC++来开发。

另外一种是ActiveX。可以在VB、VBA、及VL中使用，它可以做到在打开AutoCAd的情况下不打开图形而对图形进行编辑。