论文部分内容阅读
摘 要:本文将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()
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
ply(i - userRange.Row + 1, 1) = Sheets(userRange.Parent.Name).Cells(i, userRange.Column + 1): ply(i - userRange.Row + 1, 2) = Sheets(userRange.Parent.Name).Cells(i, userRange.Column)
x = UBound(xy)'獲取数组xy的最大下标
ReDim Preserve xy(x + 3)
For y = 1 To 3
xy(x + y) = p2(y - 1)
Next y
If x > 3 Then objPL.Delete'删除前一次画得多段线
Set objPL = acadDoc.ModelSpace.AddPolyline(xy)
p1(2) = p2(2) '将第二点的端点保存为下一条直线的第一个端点坐标
Loop Until i >= (userRange.Row + userRange.Rows.Count - 1)
Erase p1, p2, xy '释放数组空间
MsgBox "路线绘制已完成", vbMsgBoxSetForeground
acadApp.Visible = True 'CAD可见，如没有这句CAD在后台运行，在进程中可以找到
acadApp.Application.ZoomExtents'CAD窗口缩放
Err_Control:
End Sub
Sub line_mark()
Dim userRange1 As Range '定义桩号、偏距区域
Dim userRange2 As Range '定义路线前进方位角区域
Dim pl(2) As Double '定义文本插入点的坐标变量
Dim value As Double'定义路线类型编号
Dim strTxt As String
Dim txtobj As AcadMText
Dim AngAs Single
'输入路线的类型
On Error Resume Next
value = InputBox("请输入数字（0--主线，-1--左边桩线，1--右边桩线:", "提醒")
If Err Then MsgBox "数据类型错误，退出程序": End
If value = 0 Or value = 1 Or value = -1 Then
Call DKLD'调用桩号区域子程序
Else: MsgBox "输入数字超限，退出程序": End
End If
Ang = 1
MsgBox "线路位于曲线上，在即将弹出的输入框中" & Chr(13) _
& "请输入前进方位角，否则可不用输入", vbOKOnly + vbInformation, "李朝辉提醒您"
'录入路线前进方位角区域
On Error Resume Next
chongshi:Set userRange2 = Application.InputBox("请选取与X、Y坐标区域对应的" & Chr(13) & "前进方位角（单位为弧度）区域：", "选取范围为N行1列的非空区域", , , , , , 8)'在excel中选择坐标区域
由于篇幅有限，本文省略了桩号区域选取、中边桩标注的子程序
2.4窗体控件的建立与代码。
为便于用户使用，应建立一个傻瓜式的操作界面，先创建一个窗体，然后在窗体中放入2个命令控件，并写入如下代码。
注意第一次运行前先检查工具\引用中的AutoCAD 2004 Type Library(对AutoCAD 2004版来说)是否选中，如果没有选，应该选中。对其他版本的AutoCAD则选中相应的类型库。
3结束语：
本文所提供的方法解决了测量数据的全自动绘图问题，用户根据意愿编辑工作表格式，通过对话框输入参数，实现在CAD中全自动完成绘制和标注的过程。
本文所述的方法提高了工作效率，更具有灵活性。如果有几十公里的平面图用手工绘制，要数十个工作日甚至数百个工作日才能完成，而用此方法则需要几分钟就可以，为后续工作赢得时间；本文还提供了一种通过对话框输入参数的人机交互方式，在Excel中用户可根据自己意愿编辑工作表的样式，在CAD绘图中用户可以在新图中绘制，也可以在原有图的基础上进行绘制，更具有灵活性。
用本文方法绘制出的图形能够快速发现测量数据中比较明显的计算错误，从而大大减少施工测量复核的工作量，提高复核精度；所画图形为测量坐标直接生成的1:1图形，在图形上任意选取位置可获得平面坐标即可用于测量放样，同时图形各项特性可以直接运用于工程实体的计算，如：施工征地面积、建筑面积、结构细部尺寸计算确定等等，与传统数字计算相比具有直观、计算准确、速度快的特点。
参考文献：
[1] 张强,刘飚,等. Excel 2007与VBA编程从入门到精通[M].北京:电子工业出版社,2008.
[2] 韩泽坤,朱瑞亮. Excel VBA高效办公范例应用[M].北京:中国青年出版社,2001.
[3] 张帆,郑立楷,王华杰. AutoCAD VBA开发精彩实例教程[M].北京:清华大学出版社,2004.
[4] 顾孝烈，等. 测量学(第2 版)[M］.上海：同济大学出版社，1999 .
[5] 冯德平.测绘数据的自动处理与CAD自动绘制断面图[J].企业科技与发展,2009,16期:57-59.
注：文章内所有公式及图表请以PDF形式查看。
关键词: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()
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
ply(i - userRange.Row + 1, 1) = Sheets(userRange.Parent.Name).Cells(i, userRange.Column + 1): ply(i - userRange.Row + 1, 2) = Sheets(userRange.Parent.Name).Cells(i, userRange.Column)
x = UBound(xy)'獲取数组xy的最大下标
ReDim Preserve xy(x + 3)
For y = 1 To 3
xy(x + y) = p2(y - 1)
Next y
If x > 3 Then objPL.Delete'删除前一次画得多段线
Set objPL = acadDoc.ModelSpace.AddPolyline(xy)
p1(2) = p2(2) '将第二点的端点保存为下一条直线的第一个端点坐标
Loop Until i >= (userRange.Row + userRange.Rows.Count - 1)
Erase p1, p2, xy '释放数组空间
MsgBox "路线绘制已完成", vbMsgBoxSetForeground
acadApp.Visible = True 'CAD可见，如没有这句CAD在后台运行，在进程中可以找到
acadApp.Application.ZoomExtents'CAD窗口缩放
Err_Control:
End Sub
Sub line_mark()
Dim userRange1 As Range '定义桩号、偏距区域
Dim userRange2 As Range '定义路线前进方位角区域
Dim pl(2) As Double '定义文本插入点的坐标变量
Dim value As Double'定义路线类型编号
Dim strTxt As String
Dim txtobj As AcadMText
Dim AngAs Single
'输入路线的类型
On Error Resume Next
value = InputBox("请输入数字（0--主线，-1--左边桩线，1--右边桩线:", "提醒")
If Err Then MsgBox "数据类型错误，退出程序": End
If value = 0 Or value = 1 Or value = -1 Then
Call DKLD'调用桩号区域子程序
Else: MsgBox "输入数字超限，退出程序": End
End If
Ang = 1
MsgBox "线路位于曲线上，在即将弹出的输入框中" & Chr(13) _
& "请输入前进方位角，否则可不用输入", vbOKOnly + vbInformation, "李朝辉提醒您"
'录入路线前进方位角区域
On Error Resume Next
chongshi:Set userRange2 = Application.InputBox("请选取与X、Y坐标区域对应的" & Chr(13) & "前进方位角（单位为弧度）区域：", "选取范围为N行1列的非空区域", , , , , , 8)'在excel中选择坐标区域
由于篇幅有限，本文省略了桩号区域选取、中边桩标注的子程序
2.4窗体控件的建立与代码。
为便于用户使用，应建立一个傻瓜式的操作界面，先创建一个窗体，然后在窗体中放入2个命令控件，并写入如下代码。
注意第一次运行前先检查工具\引用中的AutoCAD 2004 Type Library(对AutoCAD 2004版来说)是否选中，如果没有选，应该选中。对其他版本的AutoCAD则选中相应的类型库。
3结束语：
本文所提供的方法解决了测量数据的全自动绘图问题，用户根据意愿编辑工作表格式，通过对话框输入参数，实现在CAD中全自动完成绘制和标注的过程。
本文所述的方法提高了工作效率，更具有灵活性。如果有几十公里的平面图用手工绘制，要数十个工作日甚至数百个工作日才能完成，而用此方法则需要几分钟就可以，为后续工作赢得时间；本文还提供了一种通过对话框输入参数的人机交互方式，在Excel中用户可根据自己意愿编辑工作表的样式，在CAD绘图中用户可以在新图中绘制，也可以在原有图的基础上进行绘制，更具有灵活性。
用本文方法绘制出的图形能够快速发现测量数据中比较明显的计算错误，从而大大减少施工测量复核的工作量，提高复核精度；所画图形为测量坐标直接生成的1:1图形，在图形上任意选取位置可获得平面坐标即可用于测量放样，同时图形各项特性可以直接运用于工程实体的计算，如：施工征地面积、建筑面积、结构细部尺寸计算确定等等，与传统数字计算相比具有直观、计算准确、速度快的特点。
参考文献：
[1] 张强,刘飚,等. Excel 2007与VBA编程从入门到精通[M].北京:电子工业出版社,2008.
[2] 韩泽坤,朱瑞亮. Excel VBA高效办公范例应用[M].北京:中国青年出版社,2001.
[3] 张帆,郑立楷,王华杰. AutoCAD VBA开发精彩实例教程[M].北京:清华大学出版社,2004.
[4] 顾孝烈，等. 测量学(第2 版)[M］.上海：同济大学出版社，1999 .
[5] 冯德平.测绘数据的自动处理与CAD自动绘制断面图[J].企业科技与发展,2009,16期:57-59.
注：文章内所有公式及图表请以PDF形式查看。