利用VBA编程，将EXCEL数据直接导入CAD绘图
如题，编制VBA程序，可实现将EXCEL表格中的数据（坐标值）导入CAD中直接绘图生成平面或者立体的单线图（轴线图），主要是实现直线(Line)的功能。 等待高手回应~~~ <p>给你一个我编写的源代码，你可以从中得到想要的。</p><p></p><p>Sub clb() '画材料表<br/>On Error GoTo err<br/>Dim textObj As AcadText<br/>Dim myselect(0 To 13) As AcadEntity<br/>Dim mytxt As AcadTextStyle '定义mytxt变量为文本样式<br/>Dim d As Long<br/>Dim p(0 To 2) As Double '插入点<br/>Dim excelapp As Excel.Application '定义excle应用程序变量<br/>Dim excelsheet As Worksheet '定义工作表变量<br/>Dim p1 As Variant '申明端点坐标<br/>Dim p2 As Variant '申明端点坐标<br/>Dim i As Long<br/>Dim x As Long<br/>Dim y As Long<br/>Dim a1(0 To 2) As Double<br/>Dim a2(0 To 2) As Double<br/>Dim pp(0 To 9) As Double '定义点坐标<br/>Dim txt<br/>Dim corow As Long<br/>Dim attrtxt0 As String<br/>Dim attrtxt00 As String<br/>Dim attrtxt1 As String<br/>Dim attrtxt2 As String<br/>Dim attrtxt3 As String<br/>Dim attrtxt4 As String<br/>Dim attrtxt5 As String<br/>Dim attrtxt6 As String<br/>Dim attrtxt7 As String<br/>Set excelapp = CreateObject("excel.application") '激活excel程序<br/>excelapp.Workbooks.Open (ThisDrawing.path & "/物料表.xls") '打开工作薄<br/>Set excelsheet = excelapp.ActiveWorkbook.Sheets("sheet1") '当前工作表为sheet1<br/>corow = excelsheet.UsedRange.Rows.Count '计算工作表的总行数</p><p>p1 = ThisDrawing.Utility.GetPoint(, "物料表图框左上角点:") '获取点坐标<br/>p2 = ThisDrawing.Utility.GetPoint(, "物料表图框右上角点:") '获取点坐标<br/>p1(0) = Int(p1(0))<br/>p1(1) = Int(p1(1))<br/>p2(0) = Int(p2(0))<br/>p2(1) = Int(p2(1))<br/>Call addlay("物料表", 3)<br/>d = Sqr((p2(0) - p1(0)) ^ 2 + (p2(1) - p1(1)) ^ 2)<br/>If d > 590 Then 'A2图框<br/>pp(0) = p1(0) + 20: pp(1) = p1(1) - 39<br/>pp(2) = p1(0) + 507: pp(3) = p1(1) - 39<br/>pp(4) = p1(0) + 507: pp(5) = p1(1) - 379<br/>pp(6) = p1(0) + 20: pp(7) = p1(1) - 379<br/>pp(8) = p1(0) + 20: pp(9) = p1(1) - 39<br/>Set myselect(1) = ThisDrawing.ModelSpace.AddLightWeightPolyline(pp)<br/>myselect(1).color = 4<br/>End If<br/> a1(0) = p1(0) + 20: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 507: a2(1) = p1(1) - 76: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 40: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 40: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 62: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 62: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 97: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 97: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 117: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 117: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 147: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 147: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 184: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 184: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 219: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 219: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 258: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 258: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> <br/> a1(0) = p1(0) + 269: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 269: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 289: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 289: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 311: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 311: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 346: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 346: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 366: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 366: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 396: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 396: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 433: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 433: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/> a1(0) = p1(0) + 463: a1(1) = p1(1) - 76: a1(2) = 0<br/> a2(0) = p1(0) + 463: a2(1) = p1(1) - 379: a2(2) = 0<br/> ThisDrawing.ModelSpace.AddLine a1, a2<br/>x = p1(0) + 32: y = p1(1) - 93</p><p> a1(0) = x - 12: a1(1) = y: a1(2) = 0<br/> a2(0) = x + 226: a2(1) = y: a2(2) = 0<br/>Set myselect(1) = ThisDrawing.ModelSpace.AddLine(a1, a2)<br/> a1(0) = x + 237: a1(1) = y: a1(2) = 0<br/> a2(0) = x + 475: a2(1) = y: a2(2) = 0<br/>Set myselect(1) = ThisDrawing.ModelSpace.AddLine(a1, a2)</p><p>For i = 1 To 25<br/> a1(0) = x - 12: a1(1) = y - i * 11: a1(2) = 0<br/> a2(0) = x + 226: a2(1) = y - i * 11: a2(2) = 0<br/>Set myselect(1) = ThisDrawing.ModelSpace.AddLine(a1, a2)<br/>myselect(1).color = 251<br/> a1(0) = x + 237: a1(1) = y - i * 11: a1(2) = 0<br/> a2(0) = x + 475: a2(1) = y - i * 11: a2(2) = 0<br/>Set myselect(1) = ThisDrawing.ModelSpace.AddLine(a1, a2)<br/>myselect(1).color = 251<br/>Next i<br/>Call addlay("文字标注", 3)<br/>'-------------------------------------------------------<br/>Set mytxt = ThisDrawing.TextStyles.Add("说明") '添加说明样式<br/>mytxt.fontFile = "c:\windows\fonts\SIMHEI.TTF" '设置字体文件为仿宋体<br/>mytxt.Height = 100 '字高<br/>mytxt.Width = 0.8 '宽高比<br/>ThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为mytxt<br/> a1(0) = x + 9: a1(1) = y + 29: a1(2) = 0<br/> attrtxt00 = excelsheet.Cells(2, 9).Value '序号<br/> If corow > 52 Then<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt00 & "物 料 表 (一) ", a1, 10)<br/> txt.Alignment = acAlignmentLeft<br/> Else<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt00 & "物 料 表 ", a1, 10)<br/> txt.Alignment = acAlignmentLeft<br/> End If<br/> a1(0) = x - 2: a1(1) = y + 8.5: a1(2) = 0<br/> Set txt = ThisDrawing.ModelSpace.AddText("类别", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 19: a1(1) = y + 8.5: a1(2) = 0<br/> Set txt = ThisDrawing.ModelSpace.AddText("代号", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 47: a1(1) = y + 8.5: a1(2) = 0<br/>Set txt = ThisDrawing.ModelSpace.AddText("材料名称", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> <br/> a1(0) = x + 75: a1(1) = y + 8.5: a1(2) = 0<br/>Set txt = ThisDrawing.ModelSpace.AddText("品牌", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> <br/> a1(0) = x + 100: a1(1) = y + 8.5: a1(2) = 0<br/>Set txt = ThisDrawing.ModelSpace.AddText("规格型号", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 133: a1(1) = y + 8.5: a1(2) = 0<br/>Set txt = ThisDrawing.ModelSpace.AddText("电话", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 169: a1(1) = y + 8.5: a1(2) = 0<br/>Set txt = ThisDrawing.ModelSpace.AddText("部位", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 206: a1(1) = y + 8.5: a1(2) = 0<br/>Set txt = ThisDrawing.ModelSpace.AddText("工艺要求", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> <br/> a1(0) = x + 247: a1(1) = y + 8.5: a1(2) = 0<br/> Set txt = ThisDrawing.ModelSpace.AddText("类别", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 268: a1(1) = y + 8.5: a1(2) = 0<br/> Set txt = ThisDrawing.ModelSpace.AddText("代号", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 296.5: a1(1) = y + 8.5: a1(2) = 0<br/>Set txt = ThisDrawing.ModelSpace.AddText("材料名称", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> <br/> a1(0) = x + 324: a1(1) = y + 8.5: a1(2) = 0<br/>Set txt = ThisDrawing.ModelSpace.AddText("品牌", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> <br/> a1(0) = x + 349: a1(1) = y + 8.5: a1(2) = 0<br/>Set txt = ThisDrawing.ModelSpace.AddText("规格型号", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 382: a1(1) = y + 8.5: a1(2) = 0<br/>Set txt = ThisDrawing.ModelSpace.AddText("电话", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 416: a1(1) = y + 8.5: a1(2) = 0<br/>Set txt = ThisDrawing.ModelSpace.AddText("部位", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 452: a1(1) = y + 8.5: a1(2) = 0<br/>Set txt = ThisDrawing.ModelSpace.AddText("工艺要求", a1, 5)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> '--------------------------------------------------------</p><p>For i = 1 To 26</p><p> attrtxt0 = excelsheet.Cells(i + 1, 1).Value '类别<br/> attrtxt1 = excelsheet.Cells(i + 1, 2).Value '代号<br/> attrtxt2 = excelsheet.Cells(i + 1, 3).Value '材料名称<br/> attrtxt3 = excelsheet.Cells(i + 1, 4).Value '品牌<br/> attrtxt4 = excelsheet.Cells(i + 1, 5).Value '型号<br/> attrtxt5 = excelsheet.Cells(i + 1, 6).Value '电话<br/> attrtxt6 = excelsheet.Cells(i + 1, 7).Value '部位<br/> attrtxt7 = excelsheet.Cells(i + 1, 8).Value '工艺要求<br/> a1(0) = x - 2<br/> a1(1) = y - 5.5 - (i - 1) * 11<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt0, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 19<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt1, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 47<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt2, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 75<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt3, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 100<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt4, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 133<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt5, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 169<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt6, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 206<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt7, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/>Next i<br/>'-------------------------------------------------------'<br/>If corow > 26 Then<br/> For i = 27 To 52</p><p> attrtxt0 = excelsheet.Cells(i + 1, 1).Value '类别<br/> attrtxt1 = excelsheet.Cells(i + 1, 2).Value '代号<br/> attrtxt2 = excelsheet.Cells(i + 1, 3).Value '材料名称<br/> attrtxt3 = excelsheet.Cells(i + 1, 4).Value '品牌<br/> attrtxt4 = excelsheet.Cells(i + 1, 5).Value '型号<br/> attrtxt5 = excelsheet.Cells(i + 1, 6).Value '电话<br/> attrtxt6 = excelsheet.Cells(i + 1, 7).Value '部位<br/> attrtxt7 = excelsheet.Cells(i + 1, 8).Value '工艺要求<br/> a1(0) = x + 247<br/> a1(1) = y - 5.5 - (i - 27) * 11<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt0, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 268<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt1, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 296.5<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt2, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 324<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt3, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 349<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt4, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 382<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt5, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 416<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt6, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> a1(0) = x + 452<br/> Set txt = ThisDrawing.ModelSpace.AddText(attrtxt7, a1, 4)<br/> txt.Alignment = acAlignmentMiddleCenter<br/> txt.TextAlignmentPoint = a1<br/> Next i<br/>End If</p><p>err:<br/>excelapp.Quit '退出excel程序<br/>Set excelapp = Nothing '释放变量<br/>Set excelsheet = Nothing<br/>End Sub</p> nhy12345678 发表于 2008-5-15 10:56 static/image/common/back.gif给你一个我编写的源代码，你可以从中得到想要的。Sub clb() '画材料表On Error GoTo errDim textObj As Aca ...
看你的代码打开的是excel2003的文件要是excel2007的文件怎么写呢
新鲜1688 发表于 2015-12-21 10:09 static/image/common/back.gif
看你的代码打开的是excel2003的文件要是excel2007的文件怎么写呢
把2007另存为2003 楼主能否提供一下附件啊 nhy12345678 发表于 2008-5-15 10:56
给你一个我编写的源代码，你可以从中得到想要的。Sub clb() '画材料表On Error GoTo errDim textObj As Aca ...
谢谢楼主的分享，谢谢！
页:
[1]