[日积月累]：CAD和EXCEL的相互打开

ahlzl

我是VBA新手，总结了几条，供新手参考，高手就不必看了！
一、在CAD中打开EXCEL。以下三段代码都行：
Sub EXCEL()
Dim ex As EXCEL.Application
Set ex = New EXCEL.Application
ex.Visible = True
'以下一句换成ex.Workbooks.Open ("c:\1.xls")，则打开一工作薄
ex.Workbooks.Add
'给一单元格赋值
ex.Worksheets(2).Cells(1, 1).Value = 234
End Sub


Sub EXCEL()
Dim ex As Object
'以下一句换成Set ex = Workbooks.Open("c:\1.xls").Application
'则打开一工作薄
Set ex = Workbooks.Add.Application
ex.Visible = True
'给一单元格赋值
ex.Sheets(2).Cells(1, 2).Value = 123
End Sub


Sub EXCEL()
Dim ex As EXCEL.Application
Set ex = CreateObject("excel.application")
ex.workbooks.add
ex.Visible = True
End Sub

二、在EXCEL中打开CAD
Sub AutoCAD()
    Dim Aut As Object
    Set Aut = New AutoCAD.AcadApplication
    Aut.Visible = True
    '下面加一行aut.Documents.Open ("c:\1.dwg")
    '则打开一DWG文件
    Dim SLine(0 To 2) As Double
    Dim Eline(0 To 2) As Double
    SLine(0) = Cells(2, 2).Value
    SLine(1) = Cells(3, 2).Value
    Eline(0) = Cells(2, 3).Value
    Eline(1) = Cells(3, 3).Value
    Aut.ActiveDocument.ModelSpace.AddLine SLine, Eline
End Sub
  
Sub AutoCAD()
    Dim Aut As AcadApplication
    Set Aut = CreateObject("AutoCAD.Application")
    Aut.Visible = True
    '下面加一行aut.Documents.Open ("c:\1.dwg")
    '则打开一DWG文件
    Dim SLine(0 To 2) As Double
    Dim Eline(0 To 2) As Double
    Dim p As AcadLine
    SLine(0) = Cells(2, 2).Value
    SLine(1) = Cells(3, 2).Value
    Eline(0) = Cells(2, 3).Value
    Eline(1) = Cells(3, 3).Value
    Set p = Aut.ActiveDocument.ModelSpace.AddLine(SLine, Eline)
End Sub

Sub autoCAD()
Dim aut As AcadApplication
Set aut = New AcadApplication
aut.Visible = True
'下面加一行aut.Documents.Open ("c:\1.dwg")
'则打开一DWG文件
Dim SLine(0 To 2) As Double
    Dim Eline(0 To 2) As Double
    SLine(0) = Cells(2, 2).Value
    SLine(1) = Cells(3, 2).Value
    Eline(0) = Cells(2, 3).Value
    Eline(1) = Cells(3, 3).Value
    aut.ActiveDocument.ModelSpace.AddLine SLine, Eline
End Sub
不要忘了引用啊！

Laoyao

其实，这种调用有两种形式
1）前期绑定：变量直接定义为要打开的程序类型
  如定义为EXCEL时     Dim ex As EXCEL.Application
     定义为ACAD时      Dim aut As AcadApplication
这时必须“不要忘了引用啊！”
Sub EXCEL()
Dim ex As EXCEL.Application
Set ex = New EXCEL.Application
ex.Visible = True
'以下一句换成ex.Workbooks.Open ("c:\1.xls")，则打开一工作薄
ex.Workbooks.Add
'给一单元格赋值
ex.Worksheets(2).Cells(1, 1).Value = 234
End Sub


Sub autoCAD()
Dim aut As AcadApplication
Set aut = New AcadApplication
aut.Visible = True
'下面加一行aut.Documents.Open ("c:\1.dwg")
'则打开一DWG文件
Dim SLine(0 To 2) As Double
Dim Eline(0 To 2) As Double
SLine(0) = Cells(2, 2).Value
SLine(1) = Cells(3, 2).Value
Eline(0) = Cells(2, 3).Value
Eline(1) = Cells(3, 3).Value
aut.ActiveDocument.ModelSpace.AddLine SLine, Eline
End Sub




2）后期绑定。只定义为OBJECT  Dim Aut As Object，实际类型在程序中创建。
  如创建为EXCEL时     Set ex = CreateObject("excel.application")
     创建为ACAD时      Set Aut = CreateObject("AutoCAD.Application")
此时不需要引用。

Sub AutoCAD()
Dim Aut As AcadApplication
Set Aut = CreateObject("AutoCAD.Application")
Aut.Visible = True
'下面加一行aut.Documents.Open ("c:\1.dwg")
'则打开一DWG文件
Dim SLine(0 To 2) As Double
Dim Eline(0 To 2) As Double
Dim p As AcadLine
SLine(0) = Cells(2, 2).Value
SLine(1) = Cells(3, 2).Value
Eline(0) = Cells(2, 3).Value
Eline(1) = Cells(3, 3).Value
Set p = Aut.ActiveDocument.ModelSpace.AddLine(SLine, Eline)
End Sub

Sub AutoCAD()
Dim Aut As Object
Set Aut = CreateObject("AutoCAD.Application")Aut.Visible = True
'下面加一行aut.Documents.Open ("c:\1.dwg")
'则打开一DWG文件
Dim SLine(0 To 2) As Double
Dim Eline(0 To 2) As Double
SLine(0) = Cells(2, 2).Value
SLine(1) = Cells(3, 2).Value
Eline(0) = Cells(2, 3).Value
Eline(1) = Cells(3, 3).Value
Aut.ActiveDocument.ModelSpace.AddLine SLine, Eline
End Sub

Laoyao

一、在CAD中调用已打开的EXCEL。
Sub EXCEL()
    On Error Resume Next
    Dim xlApp As Object
    Dim xlWorkbooks As Object
    Set xlApp = GetObject(, "excel.application") '得到已打开的EXCEL
    Set xlWorkbooks = xlApp.workbooks
   
    xlWorkbooks(1).sheets(1).cells(1, 1) = "AAA" '在INDEX为1的BOOK的INDEX为1的SHEET的（1，1）CELL中写入”AAA“ 也可以将INDEX改为BOOK或SHEET的名字， xlWorkbooks("BOOK1").sheets("SHEET1").cells(1, 2) = "AAA"
   
End Sub

二、在EXCEL中调用已打开的CAD。
Sub AutoCAD()
Dim acadApp As AcadApplication
Dim acadDocs As AcadDocuments
Set acadApp = AcadApplication
Set acadDocs = acadApp.Documents
acadApp.Visible = True
Dim SLine(0 To 2) As Double
Dim Eline(0 To 2) As Double
SLine(0) = 0
SLine(1) = 0
Eline(0) = 1000
Eline(1) = 500
acadDocs.Item(0).ModelSpace.AddLine SLine, Eline
End Sub

ahlzl

看了Laoyao 的贴子，收获很大，颇受启发。谢谢！
希望Laoyao、efam2000两位写一在CAD中通过ADO调用EXCEL的一段完整代码。