AUTOCAD+VBA+生成道路测量中的纵横断面数据表版2.docx

1、AUTOCAD+VBA+生成道路测量中的纵横断面数据表版2AUTOCAD VBA 辅助制作道路测量中的纵横断面数据表中国有色金属工业长沙勘察设计研究院珠海分院 苏伟AUTOCAD集成的VBA为AUTOCAD二次开发提了一个便捷途径，通过VBA可实现AUTOCAD与其它应用软件进行通信，实现数据交换，本文介绍如何利用AUTOCAD VBA编程建立与Excel通信（本文中所使用的为AUTOCAD2004及EXCEL2007），方便快捷的生成道路纵横断面数据表。关键词：AUTOCAD VBA与EXCEL通信 纵横断面数据表一前言 在道路测量中，为满足设计方要求，不但需要AUTOCAD电子地形图，还需

2、要能够反映道路设计线上地表起伏状况的电子纵横断面数据表，纵横面数据表为反映设计中线上地表起伏状况，横面数据表为反映与设计线垂直的截面地表起伏状况。纵横断面数据表为能够批量形成纵横断面图，需要有固定格式，一般格式：如图1 图2 所示：在没有辅助软件情况下，利用现有电子地形图制作纵横数据表，需要进行大量繁琐的工作，即劳神，又易出错，本文介绍利用AUTOCAD VBA编程实现只在AUTOCAD中操作，完成在EXCEL中形成纵横断面数据表。图1图2二工作机理1.VBA简介：VISUAL BASIC FOR APPLICATION (VBA)是MICROSEFT面向最终用户应用软件编程语言，基于AUTO

3、CAD的VBA应用程序是高级程序语言的计算功能与AUTOCAD的绘图功能的结合，通过AUTOCAD VBA编程，能够使AUTOCAD数据与EXCEL等联合工作。2.机理分析：在MICRASOFT EXCEL 中与表对应的对象是工作表(sheet或worksheet)与每一个单元格对应的对象是单元格式(CELL).工作表对象中的CELLS属性。它是以行（ROW）和列(GOLUMN）作为参数，对于行和列选择可采用变量形式，在本文中可设定工作表(WORKSHEET）的每个单元格CELL（i j ）来操作工作表，（ i 表示行数，j 表示列数，i ,j 都要为正整数）。三具体实现方法1.1 AUTOC

4、AD VBA 程序与EXCEL建立联接，并创建新EXCEL表。 要在AUTOCAD中操作EXCEL,就必须利用VBA将EXCEL中的对象能让用户使用，就需要让AUTOCAD VBA引用EXEEL对象库操作步骤如下： 步骤1：在AUTOCAD（AUTOCAD2004以上版本）中打开VBA管理器，创建一个工程将其保存为“制表”。 步骤2：进入VBA集成开发环境，双击“工程资源管理器”窗口中的THISDRAWING图标，打开代码窗口，选择“工具/引用”菜单项，打开如图3所示对话框，选中MICROSOFT EXCEL 12.0 OBJECT LIBRARY (EXCEL对象库，其版本与计算机上安装的O

5、FFICE 版本有关，12.0是OFFICE2007对应的版本号)，引用类型库实际上是向编译器表示本程序要使用一个已注册的组件，引用对象库后就可以在对象浏览器中观察对象库中的对象，方法和属性。步骤3：完成对EXCEL对象库引用后，就可在程序中随时调用EXCEL中的对象。可按如下代码来创建完整的EXCEL对象引用实例：Public excelapp As Excel.Application 定义EXCEL对象变量Public excelworkbook As Excel.Workbook 定义工作簿对象变量Public excelsheet As Excel.Worksheet 定义工作表对象变

6、量Public Sub linkexcel() On Error Resume Next Set excelapp = GetObject(, excel.application) If Err Then Err.Clear Set excelapp = CreateObject(excel.application) If Err Then Err.Clear MsgBox 请检查EXCEL Exit Sub End If End If Set excelworkbook = excelapp.Workbooks.Add 创建新工作簿 Set excelsheet = excelworkboo

7、k.Worksheets(sheet1) excelapp.WindowState = xlMinimized EXCEL程序窗口最小化 End Sub图31.2通过在AUTOCAD中提示用户进行鼠标和键盘的操作获得距离和高程数据，并将数据写入创建的EXCEL表中的指定单元格。由于纵横断面数据表格式不同，所以要分别用两个独立程序过程来完成。1.2.1制作纵断面数据表的程序步骤可分为以下几步：步骤1：程序运行，提示用户用鼠标确定纵断面起点心(或第一点)并记录点位。步骤2：提示用户鼠标确定断面点(或第二点)。用户输入断面点后，程序计算与起点间平距并提示用户鼠标捕捉的点位高程是否正确，然后将平离和高

8、程写入EXCEL指定单元格中。步骤3：循环步骤2；如用户需要直接输入高程和距离，则输入对应关键字后(程序中为”a”)，程序开始接受用户输入；如道路有拐点，用户可输入对应关键字，程序提示用户鼠标确定拐点(插入拐点后，程序跳至步骤1开始运行)。步骤4：制作纵断面数据表完成，用户输入关键字(程序中为”e”)，程序结束，并提示用户保存EXCEL文件。制作纵断面数据表程序代码：Public Sub getzdm()Dim pt1 As Variant 定义点位变量Dim pt2 As Variant 定义点位变量Dim h As Variant 定义断面点高程变量Dim s As Single 定义断面

9、点间距变量Dim strinput As String 定义用户输入高程和距离变量数组Dim strinput1 As Variant 定义用户输入高程和距离变量数组Dim i, j As Integer 定义引用EXCEL单元格的行列号变量Dim biaoji As AcadCircle 定义一个圆，标记鼠标捕捉的点位Dim bases As Single bases = 0 i = 1: j = 1Call linkexcel 调用linkexcel过程连接并创建EXCEL文件 On Error Resume Next 设置错误陷阱，如有错误执行下一行选取第一点(纵断面起点)coledat

10、a1:Dim keywordlist2 As String keywordlist2 = A E 定义用户输入关键字ThisDrawing.Utility.InitializeUserInput 128, keywordlist2 pt1 = ThisDrawing.Utility.GetPoint(, 输入起点输入距离高程(A)/完成(E):)判断用户输入的关键字,确定不同的运行方法 If Err Then If StrComp(Err.Description, 用户输入的是关键字, 1) = 0 Then strinput = ThisDrawing.Utility.GetInput 获得

11、用户输入的关键字 If StrComp(strinput, a, 1) = 0 Then strinput1 = ThisDrawing.Utility.GetPoint(, 输入距中桩距离高程:) excelsheet.Cells(i, j) = strinput1(0) EXCEL中写入里程 excelsheet.Cells(i, j + 1) = strinput1(1) EXCEL中写入高程 i = i + 1 EXCEL换行 Err.Clear 错误信息清除 GoTo coledata1 程序跳至coledata1运行 ElseIf StrComp(strinput, e, 1) =

12、 0 Then MsgBox 断面数据已形成，请保存:-） excelapp.Visible = True Set excelsheet = Nothing 释放对象变量 Set excelapp = Nothing 释放对象变量 Exit Sub End If End If End If 选取第二点(断面点)及输入高程Colsecond:Dim keywordlist5 As String keywordlist5 = I E A 定义用户输入关键字 ThisDrawing.Utility.InitializeUserInput 128, keywordlist5 pt2 = ThisDra

13、wing.Utility.GetPoint(pt1, 输入第二点/插入拐点(I)/输入距离高程(A)/完成(E):) 判断用户输入的关键字,确定不同的运行方法 If Err Then If StrComp(Err.Description, 用户输入的是关键字, 1) = 0 Then strinput = ThisDrawing.Utility.GetInput If StrComp(strinput, I, 1) = 0 Then 插入道路拐点的方法 bases = excelsheet.Cells(i - 1, j) Err.Clear GoTo coledata1 程序跳至coledat

14、a1运行 ElseIf StrComp(strinput, e, 1) = 0 Then Err.Clear MsgBox 断面数据已形成，请保存:-） excelapp.Visible = True Set excelsheet = Nothing 释放对象变量 Set excelapp = Nothing 释放对象变量 Exit Sub ElseIf StrComp(strinput, A, 1) = 0 Then strinput1 = ThisDrawing.Utility.GetPoint(, 输入距中桩距离高程:) excelsheet.Cells(i, j) = strinput

15、1(0) excelsheet.Cells(i, j + 1) = strinput1(1) i = i + 1 Err.Clear GoTo Colsecond 程序跳至Colsecond运行 End If End If End If 当用户没有输入关键字时的程序运行方法biaoji.Delete 删除上一点的圆圈标记 Set biaoji = ThisDrawing.ModelSpace._AddCircle(pt2, 0.5) 用圆圈标记鼠标捕捉的点位 s = Hs(pt1, pt2) 调用自定义函数计算平距 h = pt2(2) 获得鼠标捕捉的高程 获得用户输入的高程 strinput

16、 = ThisDrawing.Utility.GetString(False, 点位高程为 & h & :) If strinput = Then excelsheet.Cells(i, j) = Round (s,2) + bases EXCEL中写入里程 excelsheet.Cells(i, j + 1) = h EXCEL中写入高程 i = i + 1 GoTo Colsecond 程序跳至Colsecond运行 Else h = strinput excelsheet.Cells(i, j) = Round(s,2) + bases excelsheet.Cells(i, j + 1

17、) = h i = i + 1 GoTo Colsecond 程序跳至Colsecond运行 End If If Err Then Err.Clear End IfEnd Su由于在制作数据表过程中，一般情况下可用鼠标来捕捉图形中的点位来获得距离和高程，但有时需要直接输入距离和高程而不需要鼠标在图形中捕捉获得。为此，程序在提示用户输入点位时，加入了一些关键字(如：”e”,”i” 等)的提示操作，输入不同关键字，可让程序能灵活的应对用户的工作习惯,更好提高效率。Round()和Hs()分别为内部函数和自定义函数,本文后面作简单介绍。1.2.2制作横断面数据表的程序步骤可分为以下几步：步骤1：提示

18、用户输入桩号(横断面编号)及桩高程，将用户输入的桩号和桩高程写入EXCEL的指定单元格中。步骤2：提示用户鼠标确定横断面起点(或第一点；程序默认横断面起点为横断面与道路中线交点，并且先进行左侧断面数据的录入，然后再进行右断面数据录入。)，程序记录点位。步骤3：开始左断面数据的录入，提示用户鼠标确定断面点(或第二点)；用户输入断面点后，程序计算与起点间的平距并提示用户鼠标捕捉的点位高程是否正确，然后将平离和高程写入EXCEL指定单元格中；如用户需要直接输入高程和距离，则输入对应关键字后(程序中为”a”)，程序开始接受用户输入。步骤4：在左断面数据录入中，用户可根据提示输入关键字(程序中为”t”)

19、完成左数据录入开始右断面数据录入，程序提示用户鼠标确定断面点(或第二点)；用户输入断面点后，程序计算与起点间的平距并提示用户鼠标捕捉的点位高程是否正确，然后将平离和高程写入EXCEL指定单元格中；如用户需要直接输入高程和距离，则输入对应关键字后(程序中为”a”)，程序开始接受用户输入。步骤5：断面数据录入过程中，用户可输入对应关键字(程序中为”n”)完成该横断面数据的录入并开始下一断面数据的录入；程序跳至步骤1运行。步骤6：制作横断面数据表完成，用户输入关键字(程序中为”e”)，程序结束，并提示用户保存EXCEL文件。制作横断面数据表的代码：Public Sub gethdm()Dim pt1

20、 As Variant 定义点位变量Dim pt2 As Variant 定义点位变量Dim pt3 As Variant 定义点位变量Dim biaoji As AcadCircle 定义一个圆，标记鼠标捕捉的点位Dim h As Variant 断面点高程Dim s As Single 断面点间距Dim strinput As Variant 获取用户输入字符的变量Dim i, j As Integer EXCEL行列号的变量 i = 1: j = 1创建数据文件 Call linkexcel 调用linkexcel过程连接并创建EXCEL文件 On Error Resume Next 设

21、置错误陷阱，如有错误执行下一行获取桩号及桩高程的代码getnum:Dim Zhnum As StringZhnum = ThisDrawing.Utility.GetString(False, 输入桩号,桩高/完成E:) If Zhnum = e Then 若用户输入e，则程序结束 MsgBox 断面数据已形成，请保存:-） excelapp.Visible = True Set excelsheet = Nothing 释放对象变量 Set excelapp = Nothing 释放对象变量 Exit Sub Else excelsheet.Cells(i, j) = convert1(Zh

22、num) excelsheet.Cells(i + 1, j) = convert2(Zhnum) j = j + 1 End If选取横断面中心点coledata: Dim keywordlist2 As String 定义用户输入的关键字keywordlist2 = A N E TThisDrawing.Utility.InitializeUserInput 128, keywordlist2 pt1 = ThisDrawing.Utility.GetPoint(, 输入中心点输入距离高程(A)/下一断面(N)/换向(T)完成(E):)判断用户输入的关键字,确定不同的运行方法 If Err

23、 Then If StrComp(Err.Description, 用户输入的是关键字, 1) = 0 Then strinput = ThisDrawing.Utility.GetInput 若用户输入a,则用户直接输入偏距和高程 If StrComp(strinput, a, 1) = 0 Then pt3 = ThisDrawing.Utility.GetPoint(, 输入距中桩距离高程:) excelsheet.Cells(i, j) = pt3(0) 用户输入的距离写入EXCEL excelsheet.Cells(i, j + 1) = pt3(1) 用户输入的高程写入EXCEL

24、j = j + 2 Err.Clear GoTo coledata 程序转至coledata运行若用户输入t，开始右断面数据录入，EXCEL换行 ElseIf StrComp(strinput, T, 1) = 0 Then Err.Clear i = i + 1 j = 3 GoTo coledata 程序转至coledata运行 若用户输入e，程序结束运行 ElseIf StrComp(strinput, E, 1) = 0 Then MsgBox 断面数据已形成，请保存:-） excelapp.Visible = True biaoji = Nothing 释放对象变量 Set exce

25、lsheet=Nothing 释放对象变量 Set excelapp = Nothing 释放对象变量 Exit Sub 程序结束 若用户输入n，进行下一横断面数据录入 ElseIf StrComp(strinput, N, 1) = 0 Then Err.Clear i = i + 1 j = 1 GoTo getnum 程序转至coledata运行 End If End If End If 选取第二点(断面点)及输入高程coledata2:Dim keywordlist3 As String 定义关键字keywordlist3 = A N E TThisDrawing.Utility.In

26、itializeUserInput 128, pt2 = ThisDrawing.Utility.GetPoint(pt1, 输入未点输入距离高程(A)/下一断面(N)/换向(T)完成(E):) 判断用户输入的关键字,确定不同的运行方法 If Err Then If StrComp(Err.Description, 用户输入的是关键字, 1) = 0 Then strinput = ThisDrawing.Utility.GetInput 若用户输入a,则用户直接输入偏距和高程 If StrComp(strinput, a, 1) = 0 Then pt3 = ThisDrawing.Util

27、ity.GetPoint(, 输入距中桩距离高程:) excelsheet.Cells(i, j) = pt3(0) excelsheet.Cells(i, j + 1) = pt3(1) j = j + 2 Err.Clear GoTo coledata2 若用户输入t，开始右断面数据录入，EXCEL换行 ElseIf StrComp(strinput, T, 1) = 0 Then Err.Clear i = i + 1 j = 3 GoTo coledata2 若用户输入e，程序结束运行 ElseIf StrComp(strinput, e, 1) = 0 Then MsgBox 断面数

28、据已形成，请保存:-） excelapp.Visible = True biaoji = Nothing Set excelsheet = Nothing Set excelapp = Nothing Exit Sub 若用户输入n，进行下一横断面数据录入 ElseIf StrComp(strinput, N, 1) = 0 Then Err.Clear i = i + 1 j = 1 GoTo getnum End If End If Elsebiaoji.Delete 删除上一点的圆圈标记 Set biaoji = ThisDrawing.ModelSpace.AddCircle(pt2,

29、 0.5) 用圆圈标记鼠标捕捉的点位 s = Hs(pt1, pt2) 计算用户输入两点平距h = pt2(2) 用户鼠标捕捉的高程用户确定是否要重新输入高程 pt3 = ThisDrawing.Utility.GetString(False, 点位高程为 & h & :) 若用户输入空格或回车，则将鼠标捕捉的高程写入EXCEL If pt3 = Then excelsheet.Cells(i, j) = s 偏距写入EXCEL excelsheet.Cells(i, j + 1) = h 高程写入EXCEL j = j + 2 Else h = pt3 excelsheet.Cells(i,

30、 j) = s 偏距写入EXCEL excelsheet.Cells(i, j + 1) = h 用户输入的高程写入EXCEL j = j + 2 End If End If If Err Then Err.Clear End If GoTo coledata2 程序转至coledata2运行End Sub1.3 函数是完成一些特定功能的独立运算过程，内部函数为VBA自带的函数，而自定义函数为编程者为自已编写的一些函数过程，自定义函数不但可使整段代码简洁，还可供其它程序过程随时调用。下面列出了本程序中使用的几个自定义函数。从用户输入的”桩号,高程”中，提取出桩号字符串的自定义函数Private Function convert1(s As Variant) Dim k As Integer k = InStr(s, ,) convert1 =