利用VBA实现Excel与CAD相结合自动绘制平面图
摘要:本文将Excel与CAD相结合，运用VBA语言编程，提出了一种自动绘制工程施工平面图的方法，给出了程序的思路图和主程序。改方法充分考虑了与用户进行交互的问题，大大减小了受Excel固定表格约束的影响，使程序更具有人性化特点。
    关键词:VBA；Excel；CAD；平面图
1 引言
    在公路、铁路、水利等工程施工测量中，都需要将单调、繁琐的测量数据运用软件处理方法转化为形象、直观的图形，就目前而言，Excel是使用最广泛的办公软件之一，具有强大的功能和良好的人机交互对话界面，可以方便地进行数据处理和VBA二次开发，在工程测量中有广泛的运用；CAD具有强大的绘图功能，将测量数据转为形象、直观的图形更有易于数据检核、提高计算工作准确性和工作效率，同时CAD还提供VBA二次开发。现在利用Excel开发的数据处理软件和利用CAD开发的绘图软件很多，而把两者相结合利用VBA实现在Excel中自动打开CAD绘图功能却很少。对此，本文作了一些有益的尝试。
    本文所阐述的是用电子表格Excel和CAD相结合的方法，根据人机交互对话界面提示选取原始数据区域，借助Excel中的VBA启动CAD，并在CAD中自动绘图。另外根据用户选择的图形文件，在其图形中绘制新的图形，实现新老图合并，也是本文的一大特。本文最后给出了关于平面图自动绘制和桩号标注的源程序，该程序在Excel 2007和CAD2004中测试通过。
2基本思路和方法
    基本思路是按照用户选取的CAD图形文件名判断该图形是否在Windows界面下打开，按照提示对话框选取桩号、偏距、坐标、前进方位角区域，下一步会询问用户是否标注，根据用户选择来进行下一步操作。
2.1首先打开一个电子表格，录入原始数据。
    在Excel工作表第一列输入里程桩号，第二列输入偏移的外距，第三列输入X坐标，第四列输入Y坐标，第五列输入路线的前进方位角（以弧度为单位），如图2所示，其中除了保证里程与偏移外距两列为连续的两列，中间不允许插入空列或隐藏列；X、Y两列为连续的
两列，中间不允许插入空列或隐藏列外，其它区域可以任由用户编辑，若用户忽略前进方位角或前进方位角一列输入0，则标注桩号的方向呈水平状态。
    图1 基本思路图
    表1原始数据样表
2.2程序运行过程及成果展示。
    以中桩数据为例，运行程序，首先弹出对话框，有CAD图形文件(*.dwg)和CAD运行程序(*.exe)两种，用户根据自己实际所需选择文件类型；其次在弹出的”请用鼠标选取X、Y坐标所在的区域”对话框中用户根据提示选取$C$3:$D$17 区域，点击确定按钮等待片刻就会弹出”平面图已完成”对话框，此时路线的平面图已绘制；第三步出现”平面图已完成”对话框点击确定后，出现”请问：是否对平面图标注图”对话框，点击”是”进行标注，点击”否”则退出程序；第四步根据对话框提示一次输入桩号和偏移外距$A$3:$B$17区域和前进方位角$E$3:$E$17区域，最后弹出提示框”标注已完成，谢谢使用”，至此线路中线的绘制和标注已完成。
    按照同样的方法可以对线路的征地红线、所有特大桥的结构部位、涵洞的结构部位、路基填挖边线、控制点的具体位置等进行绘制和标注，从而形成直观、形象的平面图。
    由于图形较大，无法全部显示，只显示部分平面图，见图2 。
   
   
   
    图2 路线平面图一部分
    2.3 Excel中VBA程序。
    下面是画线路的主程序
    Dim acadApp As acadapplication ‘定义CAD
    Dim acadDoc As AcadDocument
    Dim x As Integer
    Dim userRange As Range ‘输入坐标区域的单元格区域N行两列的区域
    Dim ply() As Double
    Sub line_drawing()
vba做excel窗体录入教程    Dim y As Integer, I As Integer, j As Integer
    Dim fileNameObj As String ‘定义打开文件
    Dim aFile As Variant ‘数组，提取文件名fileNameObj 时使用
    Dim fullName As String ‘打开文件对话框返回的文件名
    Dim kzm As String
    Dim objPL As AcadPolyline’定义objPL为 多段线
    Dim xy() As Double ‘声明动态数组
    Dim p1(2) As Double’声明端点坐标
    Dim p2(2) As Double
    fullName = Application.GetOpenFilename(“CAD图形文件, *.dwg,CAD运行程序,*.exe”, , “请选择要打开的CAD文件，点击取消则推出程序”)
    If Len(Dir(fullName)) = False Then MsgBox “未选择CAD文件或应用程序，本系统将退出”: End ‘如果按”取消”
    kzm = Mid(fullName, Len(fullName) - 2)
    On Error Resume Next
    Set userRange = Application.InputBox(“请用鼠标选取X、Y坐标所在的区域：”, “选取范围为N行两列的非空区域”, , , , , , 8)’在excel中选择坐标区域
    If userRange Is Nothing Then End ‘点击取消按钮 则退出
    On Error Resume Next
    Set acadApp = GetObject(, “AutoCAD.Application”)’创建AutoCAD 应用程序
    If Err Then
    Err.Clear
    Set acadApp = CreateObject(“AutoCAD.Application”)
    If Err Then
    MsgBox Err.Description
    MsgBox “系统未安装AutoCAD 2004，请安装AutoCAD 2004版本”
    Exit Sub
    End If
    Else
    For Each acadDoc In Documents
    If acadDoc.Name = Dir(fullName) Then
    acadDoc.Activate
    Set acadDoc = acadApp.ActiveDocument
Exit For
    End If
    Next
    End If
    If kzm  “exe” Then’判断打开文件是否为可执行文件
    acadApp.ActiveDocument.Close
    acadApp.Documents.Open fullName
    End If
    Set acadDoc = acadApp.ActiveDocument ‘把AutoCAD当前活动的文档赋予 acadDoc
    ReDim ply(1 To userRange.Rows.Count, 1 To 2)’定义动态数组为N行两列
    I = userRange.Row’返回所选区域左上角单元格的行数
    p1(0) = Sheets(userRange.Parent.Name).Cells(I, userRange.Column + 1): p1(1) = Sheets(userRange.Parent.Name).Cells(I, userRange.Column): p1(2) = 0
    ply(1, 1) = Sheets(userRange.Parent.Name).Cells(I, userRange.Column + 1)
    ply(1, 2) = Sheets(userRange.Parent.Name).Cells(I, userRange.Column)
    ReDim xy(0 To 2) ‘定义动态数组
    xy(0) = p1(0): xy(1) = p1(1): xy(2) = p1(2)
    On Error GoTo Err_Control ‘ 出错陷井
    Do ‘开始循环
    I = I + 1
    p2(0) = Sheets(userRange.Parent.Name).Cells(I, userRange.Column + 1): p2(1) = Sheets(userRange.Parent.Name).Cells(I, userRange.Column): p2(2) = 0

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。