找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 652|回复: 3

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

[复制链接]
发表于 2003-5-28 20:45:21 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

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

×
我是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
不要忘了引用啊!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2003-5-28 21:48:37 | 显示全部楼层
其实,这种调用有两种形式
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
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-5-28 22:36:41 | 显示全部楼层
一、在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
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2003-5-28 22:56:33 | 显示全部楼层
看了Laoyao 的贴子,收获很大,颇受启发。谢谢!
希望Laoyao、efam2000两位写一在CAD中通过ADO调用EXCEL的一段完整代码。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-12-23 10:44 , Processed in 0.410509 second(s), 37 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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