AUTOCAD+VBA+生成道路测量中的纵横断面数据表版2.docx
《AUTOCAD+VBA+生成道路测量中的纵横断面数据表版2.docx》由会员分享，可在线阅读，更多相关《AUTOCAD+VBA+生成道路测量中的纵横断面数据表版2.docx（19页珍藏版）》请在冰豆网上搜索。
AUTOCAD+VBA+生成道路测量中的纵横断面数据表版2
AUTOCADVBA辅助制作道路测量中的纵横断面数据表
中国有色金属工业长沙勘察设计研究院珠海分院苏伟
AUTOCAD集成的VBA为AUTOCAD二次开发提了一个便捷途径，通过VBA可实现AUTOCAD与其它应用软件进行通信，实现数据交换，本文介绍如何利用AUTOCADVBA编程建立与Excel通信（本文中所使用的为AUTOCAD2004及EXCEL2007），方便快捷的生成道路纵横断面数据表。
关键词：
AUTOCADVBA与EXCEL通信纵横断面数据表
一．前言
在道路测量中，为满足设计方要求，不但需要AUTOCAD电子地形图，还需要能够反映道路设计线上地表起伏状况的电子纵横断面数据表，纵横面数据表为反映设计中线上地表起伏状况，横面数据表为反映与设计线垂直的截面地表起伏状况。
纵横断面数据表为能够批量形成纵横断面图，需要有固定格式，一般格式：
如图1图2所示：
在没有辅助软件情况下，利用现有电子地形图制作纵横数据表，需要进行大量繁琐的工作，即劳神，又易出错，本文介绍利用AUTOCADVBA编程实现只在AUTOCAD中操作，完成在EXCEL中形成纵横断面数据表。
图1
图2
二．工作机理
1.VBA简介：
VISUALBASICFORAPPLICATION（VBA）是MICROSEFT面向最终用户应用软件编程语言，基于AUTOCAD的VBA应用程序是高级程序语言的计算功能与AUTOCAD的绘图功能的结合，通过AUTOCADVBA编程，能够使AUTOCAD数据与EXCEL等联合工作。
2.机理分析：
在MICRASOFTEXCEL中与表对应的对象是工作表（sheet或worksheet）与每一个单元格对应的对象是单元格式（CELL）.工作表对象中的CELLS属性。
它是以行（ROW）和列（GOLUMN）作为参数，对于行和列选择可采用变量形式，在本文中可设定工作表（WORKSHEET）的每个单元格CELL（ij）来操作工作表，（i表示行数，j表示列数，i,j都要为正整数）。
三．具体实现方法
1.1AUTOCADVBA程序与EXCEL建立联接，并创建新EXCEL表。
要在AUTOCAD中操作EXCEL,就必须利用VBA将EXCEL中的对象能让用户使用，就需要让AUTOCADVBA引用EXEEL对象库操作步骤如下：
步骤1：
在AUTOCAD（AUTOCAD2004以上版本）中打开VBA管理器，创建一个工程将其保存为“制表”。
步骤2：
进入VBA集成开发环境，双击“工程资源管理器”窗口中的THISDRAWING图标，打开代码窗口，选择“工具/引用”菜单项，打开如图3所示对话框，选中MICROSOFTEXCEL12.0OBJECTLIBRARY（EXCEL对象库，其版本与计算机上安装的OFFICE版本有关，12.0是OFFICE2007对应的版本号），引用类型库实际上是向编译器表示本程序要使用一个已注册的组件，引用对象库后就可以在对象浏览器中观察对象库中的对象，方法和属性。
步骤3：
完成对EXCEL对象库引用后，就可在程序中随时调用EXCEL中的对象。
可按如下代码来创建完整的EXCEL对象引用实例：
PublicexcelappAsExcel.Application‘定义EXCEL对象变量
PublicexcelworkbookAsExcel.Workbook‘定义工作簿对象变量
PublicexcelsheetAsExcel.Worksheet‘定义工作表对象变量
PublicSublinkexcel（）
OnErrorResumeNext
Setexcelapp=GetObject（,"excel.application"）
IfErrThen
Err.Clear
Setexcelapp=CreateObject（"excel.application"）
IfErrThen
Err.Clear
MsgBox"请检查EXCEL"
ExitSub
EndIf
EndIf
Setexcelworkbook=excelapp.Workbooks.Add‘创建新工作簿
Setexcelsheet=excelworkbook.Worksheets（"sheet1"）
excelapp.WindowState=xlMinimized‘EXCEL程序窗口最小化
EndSub
图3
1.2通过在AUTOCAD中提示用户进行鼠标和键盘的操作获得距离和高程数据，并将数据写入创建的EXCEL表中的指定单元格。
由于纵横断面数据表格式不同，所以要分别用两个独立程序过程来完成。
1.2.1制作纵断面数据表的程序步骤可分为以下几步：
步骤1：
程序运行，提示用户用鼠标确定纵断面起点心（或第一点）并记录点位。
步骤2：
提示用户鼠标确定断面点（或第二点）。
用户输入断面点后，程序计算与起点间平距并提示用户鼠标捕捉的点位高程是否正确，然后将平离和高程写入EXCEL指定单元格中。
步骤3：
循环步骤2；如用户需要直接输入高程和距离，则输入对应关键字后（程序中为”a”），程序开始接受用户输入；如道路有拐点，用户可输入对应关键字，程序提示用户鼠标确定拐点（插入拐点后，程序跳至步骤1开始运行）。
步骤4：
制作纵断面数据表完成，用户输入关键字（程序中为”e”），程序结束，并提示用户保存EXCEL文件。
制作纵断面数据表程序代码：
PublicSubgetzdm（）
Dimpt1AsVariant‘定义点位变量
Dimpt2AsVariant‘定义点位变量
DimhAsVariant‘定义断面点高程变量
DimsAsSingle‘定义断面点间距变量
DimstrinputAsString‘定义用户输入高程和距离变量数组
Dimstrinput1AsVariant‘定义用户输入高程和距离变量数组
Dimi,jAsInteger‘定义引用EXCEL单元格的行列号变量
DimbiaojiAsAcadCircle'定义一个圆，标记鼠标捕捉的点位
DimbasesAsSingle
bases=0
i=1:
j=1
Calllinkexcel'调用linkexcel过程连接并创建EXCEL文件
OnErrorResumeNext'设置错误陷阱，如有错误执行下一行
'选取第一点（纵断面起点）
coledata1:
Dimkeywordlist2AsString
keywordlist2="AE"'定义用户输入关键字
ThisDrawing.Utility.InitializeUserInput128,keywordlist2
pt1=ThisDrawing.Utility.GetPoint（,"输入起点[输入距离高程（A）]/[完成（E）]:
"）
‘判断用户输入的关键字,确定不同的运行方法
IfErrThen
IfStrComp（Err.Description,"用户输入的是关键字",1）=0Then
strinput=ThisDrawing.Utility.GetInput‘获得用户输入的关键字
IfStrComp（strinput,"a",1）=0Then
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‘错误信息清除
GoTocoledata1‘程序跳至coledata1运行
ElseIfStrComp（strinput,"e",1）=0Then
MsgBox"断面数据已形成，请保存:
-）"
excelapp.Visible=True
Setexcelsheet=Nothing'释放对象变量
Setexcelapp=Nothing'释放对象变量
ExitSub
EndIf
EndIf
EndIf
'选取第二点（断面点）及输入高程
Colsecond:
Dimkeywordlist5AsString
keywordlist5="IEA"'定义用户输入关键字
ThisDrawing.Utility.InitializeUserInput128,keywordlist5
pt2=ThisDrawing.Utility.GetPoint（pt1,"输入第二点/[插入拐点（I）]/[输入距离高程（A）]/[完成（E）]:
"）
'判断用户输入的关键字,确定不同的运行方法
IfErrThen
IfStrComp（Err.Description,"用户输入的是关键字",1）=0Then
strinput=ThisDrawing.Utility.GetInput
IfStrComp（strinput,"I",1）=0Then'插入道路拐点的方法
bases=excelsheet.Cells（i-1,j）
Err.Clear
GoTocoledata1‘程序跳至coledata1运行
ElseIfStrComp（strinput,"e",1）=0Then
Err.Clear
MsgBox"断面数据已形成，请保存:
-）"
excelapp.Visible=True
Setexcelsheet=Nothing'释放对象变量
Setexcelapp=Nothing'释放对象变量
ExitSub
ElseIfStrComp（strinput,"A",1）=0Then
strinput1=ThisDrawing.Utility.GetPoint（,"输入距中桩[距离][高程]:
"）
excelsheet.Cells（i,j）=strinput1（0）
excelsheet.Cells（i,j+1）=strinput1
（1）
i=i+1
Err.Clear
GoToColsecond‘程序跳至Colsecond运行
EndIf
EndIf
EndIf
‘当用户没有输入关键字时的程序运行方法
biaoji.Delete'删除上一点的圆圈标记
Setbiaoji=ThisDrawing.ModelSpace._
AddCircle（pt2,0.5）'用圆圈标记鼠标捕捉的点位
s=Hs（pt1,pt2）‘调用自定义函数计算平距
h=pt2
（2）‘获得鼠标捕捉的高程
‘获得用户输入的高程
strinput=ThisDrawing.Utility.GetString（False,"点位高程为"&h&":
"）
Ifstrinput=""Then
excelsheet.Cells（i,j）=Round（s,2）+bases‘EXCEL中写入里程
excelsheet.Cells（i,j+1）=h‘EXCEL中写入高程
i=i+1
GoToColsecond‘程序跳至Colsecond运行
Else
h=strinput
excelsheet.Cells（i,j）=Round（s,2）+bases
excelsheet.Cells（i,j+1）=h
i=i+1
GoToColsecond‘程序跳至Colsecond运行
EndIf
IfErrThen
Err.Clear
EndIf
EndSu
由于在制作数据表过程中，一般情况下可用鼠标来捕捉图形中的点位来获得距离和高程，但有时需要直接输入距离和高程而不需要鼠标在图形中捕捉获得。
为此，程序在提示用户输入点位时，加入了一些关键字（如：
”e”,”i”等）的提示操作，输入不同关键字，可让程序能灵活的应对用户的工作习惯,更好提高效率。
Round（）和Hs（）分别为内部函数和自定义函数,本文后面作简单介绍。
1.2.2制作横断面数据表的程序步骤可分为以下几步：
步骤1：
提示用户输入桩号（横断面编号）及桩高程，将用户输入的桩号和桩高程写入EXCEL的指定单元格中。
步骤2：
提示用户鼠标确定横断面起点（或第一点；程序默认横断面起点为横断面与道路中线交点，并且先进行左侧断面数据的录入，然后再进行右断面数据录入。
），程序记录点位。
步骤3：
开始左断面数据的录入，提示用户鼠标确定断面点（或第二点）；用户输入断面点后，程序计算与起点间的平距并提示用户鼠标捕捉的点位高程是否正确，然后将平离和高程写入EXCEL指定单元格中；如用户需要直接输入高程和距离，则输入对应关键字后（程序中为”a”），程序开始接受用户输入。
步骤4：
在左断面数据录入中，用户可根据提示输入关键字（程序中为”t”）完成左数据录入开始右断面数据录入，程序提示用户鼠标确定断面点（或第二点）；用户输入断面点后，程序计算与起点间的平距并提示用户鼠标捕捉的点位高程是否正确，然后将平离和高程写入EXCEL指定单元格中；如用户需要直接输入高程和距离，则输入对应关键字后（程序中为”a”），程序开始接受用户输入。
步骤5：
断面数据录入过程中，用户可输入对应关键字（程序中为”n”）完成该横断面数据的录入并开始下一断面数据的录入；程序跳至步骤1运行。
步骤6：
制作横断面数据表完成，用户输入关键字（程序中为”e”），程序结束，并提示用户保存EXCEL文件。
制作横断面数据表的代码：
PublicSubgethdm（）
Dimpt1AsVariant‘定义点位变量
Dimpt2AsVariant‘定义点位变量
Dimpt3AsVariant‘定义点位变量
DimbiaojiAsAcadCircle'定义一个圆，标记鼠标捕捉的点位
DimhAsVariant'断面点高程
DimsAsSingle'断面点间距
DimstrinputAsVariant‘获取用户输入字符的变量
Dimi,jAsInteger‘EXCEL行列号的变量
i=1:
j=1
'创建数据文件
Calllinkexcel'调用linkexcel过程连接并创建EXCEL文件
OnErrorResumeNext'设置错误陷阱，如有错误执行下一行
'获取桩号及桩高程的代码
getnum:
DimZhnumAsString
Zhnum=ThisDrawing.Utility.GetString（False,"输入[桩号,桩高]/完成[E]:
"）
IfZhnum="e"Then‘若用户输入e，则程序结束
MsgBox"断面数据已形成，请保存:
-）"
excelapp.Visible=True
Setexcelsheet=Nothing'释放对象变量
Setexcelapp=Nothing'释放对象变量
ExitSub
Else
excelsheet.Cells（i,j）=convert1（Zhnum）
excelsheet.Cells（i+1,j）=convert2（Zhnum）
j=j+1
EndIf
'选取横断面中心点
coledata:
Dimkeywordlist2AsString'定义用户输入的关键字
keywordlist2="ANET"
ThisDrawing.Utility.InitializeUserInput128,keywordlist2
pt1=ThisDrawing.Utility.GetPoint（,"输入中心点[输入距离高程（A）]/[下一断面（N）]/[换向（T）][完成（E）]:
"）
'判断用户输入的关键字,确定不同的运行方法
IfErrThen
IfStrComp（Err.Description,"用户输入的是关键字",1）=0Then
strinput=ThisDrawing.Utility.GetInput
'若用户输入a,则用户直接输入偏距和高程
IfStrComp（strinput,"a",1）=0Then
pt3=ThisDrawing.Utility.GetPoint（,"输入距中桩[距离][高程]:
"）
excelsheet.Cells（i,j）=pt3（0）‘用户输入的距离写入EXCEL
excelsheet.Cells（i,j+1）=pt3
（1）‘用户输入的高程写入EXCEL
j=j+2
Err.Clear
GoTocoledata‘程序转至coledata运行
'若用户输入t，开始右断面数据录入，EXCEL换行
ElseIfStrComp（strinput,"T",1）=0Then
Err.Clear
i=i+1
j=3
GoTocoledata‘程序转至coledata运行
‘若用户输入e，程序结束运行
ElseIfStrComp（strinput,"E",1）=0Then
MsgBox"断面数据已形成，请保存:
-）"
excelapp.Visible=True
biaoji=Nothing'释放对象变量
Setexcelsheet=Nothing'释放对象变量Setexcelapp=Nothing'释放对象变量
ExitSub‘程序结束
‘若用户输入n，进行下一横断面数据录入
ElseIfStrComp（strinput,"N",1）=0Then
Err.Clear
i=i+1
j=1
GoTogetnum‘程序转至coledata运行
EndIf
EndIf
EndIf
'选取第二点（断面点）及输入高程
coledata2:
Dimkeywordlist3AsString'定义关键字
keywordlist3="ANET"
ThisDrawing.Utility.InitializeUserInput128,
pt2=ThisDrawing.Utility.GetPoint（pt1,"输入未点[输入距离高程（A）]/[下一断面（N）]/[换向（T）][完成（E）]:
"）
'判断用户输入的关键字,确定不同的运行方法
IfErrThen
IfStrComp（Err.Description,"用户输入的是关键字",1）=0Then
strinput=ThisDrawing.Utility.GetInput
'若用户输入a,则用户直接输入偏距和高程
IfStrComp（strinput,"a",1）=0Then
pt3=ThisDrawing.Utility.GetPoint（,"输入距中桩[距离][高程]:
"）
excelsheet.Cells（i,j）=pt3（0）
excelsheet.Cells（i,j+1）=pt3
（1）
j=j+2
Err.Clear
GoTocoledata2
'若用户输入t，开始右断面数据录入，EXCEL换行
ElseIfStrComp（strinput,"T",1）=0Then
Err.Clear
i=i+1
j=3
GoTocoledata2
‘若用户输入e，程序结束运行
ElseIfStrComp（strinput,"e",1）=0Then
MsgBox"断面数据已形成，请保存:
-）"
excelapp.Visible=True
biaoji=Nothing
Setexcelsheet=Nothing
Setexcelapp=Nothing
ExitSub
‘若用户输入n，进行下一横断面数据录入
ElseIfStrComp（strinput,"N",1）=0Then
Err.Clear
i=i+1
j=1
GoTogetnum
EndIf
EndIf
Else
biaoji.Delete'删除上一点的圆圈标记
Setbiaoji=ThisDrawing.ModelSpace.AddCircle（pt2,0.5）'用圆圈标记鼠标捕捉的点位
s=Hs（pt1,pt2）‘计算用户输入两点平距
h=pt2
（2）‘用户鼠标捕捉的高程
‘用户确定是否要重新输入高程
pt3=ThisDrawing.Utility.GetString（False,"点位高程为"&h&":
"）
‘若用户输入空格或回车，则将鼠标捕捉的高程写入EXCEL
Ifpt3=""Then
excelsheet.Cells（i,j）=s‘偏距写入EXCEL
excelsheet.Cells（i,j+1）=h‘高程写入EXCEL
j=j+2
Else
h=pt3
excelsheet.Cells（i,j）=s‘偏距写入EXCEL
excelsheet.Cells（i,j+1）=h‘用户输入的高程写入EXCEL
j=j+2
EndIf
EndIf
IfErrThen
Err.Clear
EndIf
GoTocoledata2‘程序转至coledata2运行
EndSub
1.3函数是完成一些特定功能的独立运算过程，内部函数为VBA自带的函数，而自定义函数为编程者为自已编写的一些函数过程，自定义函数不但可使整段代码简洁，还可供其它程序过程随时调用。
下面列出了本程序中使用的几个自定义函数。
'从用户输入的”桩号,高程”中，提取出桩号字符串的自定义函数
PrivateFunctionconvert1（sAsVariant）
DimkAsInteger
k=InStr（s,","）
convert1=
升级会员 