[求助]请教高手：在AutoCAD VBA中怎么打开Excel文件？？

inxiu · 发表于 2008-5-10 11:49:00

我用通用对话框打开Excel文件，但是不知为何总出错，高手请指教！
Dim Excel As Excel.Application
Dim ExcelSheet As Object
Dim ExcelWorkbook As Object
Dim ExcelName As String

'设置标准对话框
With comDlg
      .DialogTitle = "选择Excel文件"
      .Filter = "Excel文件(*.xls)|*.xls|所有文件(*.*)|*.*"
      .InitDir = "d:\my documents"
      .ShowOpen
End With

'文件类型错误的判断
If Right(comDlg.FileName, 3)  "xls" Then
      MsgBox "不支持的文件格式！", vbCritical, "警告"
      Exit Sub
End If

'打开文件的操作
'Open comDlg.FileName For Input As #1
'Close #1

ExcelName = comDlg.FileName
Excel.Workbooks.Open ExcelName
这样总有错误，说什么
Object variable or With block variable not set (Error 91)我看了半天也没懂什么原因。
但是用以下代码就正确。
'*********************************************************************************
'错误处理
'On Error Resume Next
'Set Excel = GetObject(, "Excel.Application")
'If Err  0 Then
'Set Excel = CreateObject("Excel.Application")
'End If
'打开excel表
'ExcelName = InputBox("路径：")
'Excel.Workbooks.Open ExcelName
'********************************************************************************
这样就是用了inputbox。但就是每次要打开excel文件就要手动输入文件名。太麻烦了。。。
请高手们指教！

兰州人 · 发表于 2008-5-10 22:12:00

这两条语句是关键语句
Set Excel = GetObject(, "Excel.Application")
Set Excel = CreateObject("Excel.Application")
excel文件就要手动输入文件名。太麻烦了
你要达到什么目的?

inxiu · 发表于 2008-5-11 12:51:00

我要选择一个excel文件的数据，在autocad中根据数据画出图形来。

兰州人 · 发表于 2008-5-11 14:28:00

看看我发的帖子，有专题描述，AutoCad二次开发教程有详细的介绍。
你最好发个示例，好给你讲解。

inxiu · 发表于 2008-5-11 23:24:00

这是具体的代码
是个画纵断面的程序，还有一个测试用的excel文件

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载

文件名称:kncmjgwgogc.rar
下载次数:0 文件大小:20.02 KB 售价:2银币 [记录]
下载权限: 不限以上或 Vip会员 [开通Vip] [签到领银币] [免费赚银币]

inxiu · 发表于 2008-5-11 23:36:00

按照兰州人大哥的话
Set Excel = GetObject(, "Excel.Application")
Set Excel = CreateObject("Excel.Application")
这两句话我加上去了，貌似果然正常了。。。

afei21501 · 发表于 2008-5-15 10:00:00

我也有类似疑问，不知道如何编程实现将EXCEL中的数据（坐标值，标高等）导入CAD中自动生成平面或者空间的单线图（轴线图，钢框架结构）

nhy12345678 · 发表于 2008-5-15 14:43:00

我发个例子给你：
Sub clb() '画材料表
On Error GoTo err
Dim textObj As AcadText
Dim myselect(0 To 13) As AcadEntity
Dim mytxt As AcadTextStyle '定义mytxt变量为文本样式
Dim d As Long
Dim p(0 To 2) As Double '插入点
Dim excelapp As Excel.Application '定义excle应用程序变量
Dim excelsheet As Worksheet '定义工作表变量
Dim p1 As Variant '申明端点坐标
Dim p2 As Variant '申明端点坐标
Dim i As Long
Dim x As Long
Dim y As Long
Dim a1(0 To 2) As Double
Dim a2(0 To 2) As Double
Dim pp(0 To 9) As Double '定义点坐标
Dim txt
Dim corow As Long
Dim attrtxt0 As String
Dim attrtxt00 As String
Dim attrtxt1 As String
Dim attrtxt2 As String
Dim attrtxt3 As String
Dim attrtxt4 As String
Dim attrtxt5 As String
Dim attrtxt6 As String
Dim attrtxt7 As String
Set excelapp = CreateObject("excel.application")  '激活excel程序
excelapp.Workbooks.Open (ThisDrawing.path & "/物料表.xls") '打开工作薄
Set excelsheet = excelapp.ActiveWorkbook.Sheets("sheet1") '当前工作表为sheet1
corow = excelsheet.UsedRange.Rows.Count '计算工作表的总行数
p1 = ThisDrawing.Utility.GetPoint(, "物料表图框左上角点:") '获取点坐标
p2 = ThisDrawing.Utility.GetPoint(, "物料表图框右上角点:") '获取点坐标
p1(0) = Int(p1(0))
p1(1) = Int(p1(1))
p2(0) = Int(p2(0))
p2(1) = Int(p2(1))
Call addlay("物料表", 3)
d = Sqr((p2(0) - p1(0)) ^ 2 + (p2(1) - p1(1)) ^ 2)
If d > 590 Then 'A2图框
pp(0) = p1(0) + 20: pp(1) = p1(1) - 39
pp(2) = p1(0) + 507: pp(3) = p1(1) - 39
pp(4) = p1(0) + 507: pp(5) = p1(1) - 379
pp(6) = p1(0) + 20: pp(7) = p1(1) - 379
pp(8) = p1(0) + 20: pp(9) = p1(1) - 39
Set myselect(1) = ThisDrawing.ModelSpace.AddLightWeightPolyline(pp)
myselect(1).color = 4
End If
a1(0) = p1(0) + 20: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 507: a2(1) = p1(1) - 76: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
a1(0) = p1(0) + 40: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 40: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
a1(0) = p1(0) + 62: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 62: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
   a1(0) = p1(0) + 97: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 97: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
   a1(0) = p1(0) + 117: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 117: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
   a1(0) = p1(0) + 147: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 147: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
      a1(0) = p1(0) + 184: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 184: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
      a1(0) = p1(0) + 219: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 219: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
a1(0) = p1(0) + 258: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 258: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2

a1(0) = p1(0) + 269: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 269: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
a1(0) = p1(0) + 289: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 289: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
a1(0) = p1(0) + 311: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 311: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
a1(0) = p1(0) + 346: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 346: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
a1(0) = p1(0) + 366: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 366: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
a1(0) = p1(0) + 396: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 396: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
a1(0) = p1(0) + 433: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 433: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
a1(0) = p1(0) + 463: a1(1) = p1(1) - 76: a1(2) = 0
a2(0) = p1(0) + 463: a2(1) = p1(1) - 379: a2(2) = 0
ThisDrawing.ModelSpace.AddLine a1, a2
x = p1(0) + 32: y = p1(1) - 93
a1(0) = x - 12: a1(1) = y: a1(2) = 0
a2(0) = x + 226: a2(1) = y: a2(2) = 0
Set myselect(1) = ThisDrawing.ModelSpace.AddLine(a1, a2)
a1(0) = x + 237: a1(1) = y: a1(2) = 0
a2(0) = x + 475: a2(1) = y: a2(2) = 0
Set myselect(1) = ThisDrawing.ModelSpace.AddLine(a1, a2)
For i = 1 To 25
a1(0) = x - 12: a1(1) = y - i * 11: a1(2) = 0
a2(0) = x + 226: a2(1) = y - i * 11: a2(2) = 0
Set myselect(1) = ThisDrawing.ModelSpace.AddLine(a1, a2)
myselect(1).color = 251
a1(0) = x + 237: a1(1) = y - i * 11: a1(2) = 0
a2(0) = x + 475: a2(1) = y - i * 11: a2(2) = 0
Set myselect(1) = ThisDrawing.ModelSpace.AddLine(a1, a2)
myselect(1).color = 251
Next i
Call addlay("文字标注", 3)
'-------------------------------------------------------
Set mytxt = ThisDrawing.TextStyles.Add("说明") '添加说明样式
mytxt.fontFile = "c:\windows\fonts\SIMHEI.TTF" '设置字体文件为仿宋体
mytxt.Height = 100 '字高
mytxt.Width = 0.8 '宽高比
ThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为mytxt
a1(0) = x + 9: a1(1) = y + 29: a1(2) = 0
attrtxt00 = excelsheet.Cells(2, 9).Value  '序号
If corow > 52 Then
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt00 & "物料表 (一) ", a1, 10)
   txt.Alignment = acAlignmentLeft
Else
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt00 & "物料表 ", a1, 10)
   txt.Alignment = acAlignmentLeft
End If
a1(0) = x - 2: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("类别", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
a1(0) = x + 19: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("代号", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
   a1(0) = x + 47: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("材料名称", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1

   a1(0) = x + 75: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("品牌", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1

   a1(0) = x + 100: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("规格型号", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
   a1(0) = x + 133: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("电话", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
   a1(0) = x + 169: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("部位", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
   a1(0) = x + 206: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("工艺要求", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1

a1(0) = x + 247: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("类别", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
a1(0) = x + 268: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("代号", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
   a1(0) = x + 296.5: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("材料名称", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1

   a1(0) = x + 324: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("品牌", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1

   a1(0) = x + 349: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("规格型号", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
   a1(0) = x + 382: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("电话", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
   a1(0) = x + 416: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("部位", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
   a1(0) = x + 452: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("工艺要求", a1, 5)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
'--------------------------------------------------------
For i = 1 To 26
  attrtxt0 = excelsheet.Cells(i + 1, 1).Value '类别
  attrtxt1 = excelsheet.Cells(i + 1, 2).Value '代号
  attrtxt2 = excelsheet.Cells(i + 1, 3).Value '材料名称
  attrtxt3 = excelsheet.Cells(i + 1, 4).Value '品牌
  attrtxt4 = excelsheet.Cells(i + 1, 5).Value '型号
  attrtxt5 = excelsheet.Cells(i + 1, 6).Value '电话
  attrtxt6 = excelsheet.Cells(i + 1, 7).Value '部位
  attrtxt7 = excelsheet.Cells(i + 1, 8).Value '工艺要求
  a1(0) = x - 2
  a1(1) = y - 5.5 - (i - 1) * 11
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt0, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
  a1(0) = x + 19
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt1, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
  a1(0) = x + 47
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt2, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
  a1(0) = x + 75
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt3, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
  a1(0) = x + 100
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt4, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
  a1(0) = x + 133
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt5, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
   a1(0) = x + 169
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt6, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
  a1(0) = x + 206
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt7, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
Next i
'-------------------------------------------------------'
If corow > 26 Then
  For i = 27 To 52
  attrtxt0 = excelsheet.Cells(i + 1, 1).Value '类别
  attrtxt1 = excelsheet.Cells(i + 1, 2).Value '代号
  attrtxt2 = excelsheet.Cells(i + 1, 3).Value '材料名称
  attrtxt3 = excelsheet.Cells(i + 1, 4).Value '品牌
  attrtxt4 = excelsheet.Cells(i + 1, 5).Value '型号
  attrtxt5 = excelsheet.Cells(i + 1, 6).Value '电话
  attrtxt6 = excelsheet.Cells(i + 1, 7).Value '部位
  attrtxt7 = excelsheet.Cells(i + 1, 8).Value '工艺要求
  a1(0) = x + 247
  a1(1) = y - 5.5 - (i - 27) * 11
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt0, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
  a1(0) = x + 268
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt1, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
  a1(0) = x + 296.5
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt2, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
  a1(0) = x + 324
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt3, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
  a1(0) = x + 349
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt4, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
  a1(0) = x + 382
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt5, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
   a1(0) = x + 416
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt6, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
  a1(0) = x + 452
Set txt = ThisDrawing.ModelSpace.AddText(attrtxt7, a1, 4)
   txt.Alignment = acAlignmentMiddleCenter
   txt.TextAlignmentPoint = a1
   Next i
End If
err:
excelapp.Quit '退出excel程序
Set excelapp = Nothing '释放变量
Set excelsheet = Nothing
End Sub

[求助]请教高手：在AutoCAD VBA中怎么打开Excel文件？？

发表回复

精选推荐