Excel VBA 在工程测量上的应用.docx
《Excel VBA 在工程测量上的应用.docx》由会员分享，可在线阅读，更多相关《Excel VBA 在工程测量上的应用.docx（8页珍藏版）》请在冰豆网上搜索。
ExcelVBA在工程测量上的应用
ExcelVBA在工程测量上的应用
Excel是大家很熟悉的办公软件，相信大家在工作中经常使用吧。
在测量工作中，你是否感觉到有很不方便的时候？
比如，计算一个角度的三角函数值，而角度的单位是60进制的，此时，你一定感到很无奈，因为，Excel本身无法直接计算60进制的角度的三角函数！
还有，如果你的工作表中有了点坐标值（二维或者三维），要在CAD中展绘出来，怎样才能又快又直接？
不然，就只有拐弯摸角了，很痛苦啊！
其实，只要对Excel进行一些挖掘，就可以发现Excel的功能我们还没有好好的利用呢。
Excel本身提供了强大的二次开发功能，只要我们仔细的研究，没有什么能难倒我们的。
下面，好好笔者将带你走近Excel，认识它的强大的二次开发环境VBAIDE，用它来解决上面所提到的问题，就非常容易了。
初识VBAIDE，首先，你必须懂得一些简单的VB编程常识。
如果不懂就只有通过其他的途径去学习了。
但用不着深入的研究，只要静下心来，几个小时就可以了。
打开Excel，按Alt+F11即进入VBAIDE，学过VB的人一看就知道那就是熟悉的VB界面。
下面看看如何定义一个函数，然后利用它来解决60进制的?
?
?
㈠?
0角度的三角函数计算问题。
在菜单上依次点击[插入]----->[模块]，然后输入如下代码
PublicConstpi=3.14159265359
PublicFunctionDEG（nAsDouble）
DimAAsDouble,BAsDouble,CAsDouble,DAsDouble,EAsDouble,FAsDouble,GAsDouble,KAAsDouble
D=Abs（n）+0.000000000000001
F=Sgn（n）
A=Int（D）
B=Int（（D-A）*100）
C=D-A-B/100
DEG=F*（A+B/60+C/0.36）*pi/180
EndFunction
这样，就定义了一个名字叫DEG的函数，它的作用就是转换60进制的角度为Excel认识的弧度。
编辑完后按Alt+Q即返回Excel，再在某一单元格输入=sin（deg（A1））（A1既可以是单元格的值,也可以是输入的角度值）,回车，哈哈，怎么样？
结果出来了吧？
你可以用计算器检验一下是否正确。
如果出现#NA?
?
?
㈠?
0ME？
那就要设置一下安全设置。
依次点[工具]->[宏]->[安全性]，在安全级选项卡上选择“中”或者“低”，然后关闭后重新打开就可以了，以后只要是60进制的角度，就用它转换，非常方便哦。
工程测量中，经常碰到导线的计算，如果手头没有平差计算程序就只有手工计算了，这时候你曾经想过编个小程序来计算？
其实，这很简单，笔者在宛坪（上海至武威）高速公路上做测量监理，因为有大量的导线需要复核，故编写了一个附合导线计算程序，代码很简单，但很实用。
下面是该程序的代码：
Sub附合导线计算（）
DimmAsInteger,nAsInteger,msAsDouble,ggAsDouble,shtAsObject,xxAsDouble,yyAsDouble,SAsDouble
Setsht=ThisWorkbook.ActiveSheet
DoWhilesht.Cells（m+3,4）<>""
m=m+1
Loop
Forn=3Tom+2
ms=DEG（ms）+DEG（sht.Cells（n,4））
ms=RAD（ms）
S=S+sht.Cells（n,3）
Next
ms=DEG（ms）
gg=RAD（DEG（sht.Cells（3,5））+ms-DEG（sht.Cells（3+m,5））-pi*m）
xx=0:
yy=0
Forn=4Tom+2
'方位角
sht.Cells（n,5）=RAD（DEG（sht.Cells（n-1,5））+DEG（sht.Cells（n-1,4））-pi-DEG（gg）/m）
'坐标增量
sht.Cells（n,6）=Format（sht.Cells（n-1,3）*Cos（DEG（sht.Cells（n,5）））,"#####.####"）
sht.Cells（n,7）=Format（sht.Cells（n-1,3）*Sin（DEG（sht.Cells（n,5）））,"#####.####"）
'坐标增量和
xx=xx+sht.Cells（n,6）
yy=yy+sht.Cells（n,7）
Next
xx=xx+sht.Cells（3,10）-sht.Cells（m+2,10）
yy=yy+sht.Cells（3,11）-sht.Cells（m+2,11）
sht.Cells（m+4,5）="△α="&Format（gg,"###.######"）
sht.Cells（m+4,6）="△X="&Format（xx,"###.###"）
sht.Cells（m+4,7）="△Y="&Format（yy,"###.###"）
sht.Cells（m+4,3）="∑S="&Format（S,"###.###"）
sht.Cells（m+4,9）="△S="&Format（Sqr（xx*xx+yy*yy）,"###.###"）
sht.Cells（m+4,10）="相对精度1/"&Format（S/Sqr（xx*xx+yy*yy）,"######"）
Forn=4Tom+2
sht.Cells（n,8）=Format（xx/S*sht.Cells（n-1,3）,"###.####"）
sht.Cells（n,9）=Format（yy/S*sht.Cells（n-1,3）,"###.####"）
Next
Forn=4Tom+1
sht.Cells（n,10）=sht.Cells（n-1,10）+sht.Cells（n,6）-sht.Cells（n,8）
sht.Cells（n,11）=sht.Cells（n-1,11）+sht.Cells（n,7?
?
?
㈠?
0）-sht.Cells（n,9）
Next
Columns（"F:
K"）.Select
Selection.NumberFormatLocal="0.000_"
EndSub
PublicFunctionRAD（NuAsDouble）AsDouble
DimAAsDouble,BAsDouble,CAsDouble,DAsDouble,EAsDouble,FAsDouble,GAsDouble,pAsDouble
D=Abs（Nu）
F=Sgn（Nu）
p=180#/pi
G=p*60#
A=Int（D*p）
B=Int（（D-A/p）*G）
W=B
C=（D-A/p-B/G）*20.62648062
RAD=（C+A+B/100）*F
EndFunction
值得注意的是，前面提到的DEG函数别忘记加进去。
如果自己定义一个名字叫“计算”的按钮，指定此工具的宏为“单一附合导线计算”，那么，只要按下面的格式输入原始数据（斜体是输入的），点“计算”就可以得到计算结果了。
所有的过程都是自动的，无须再手工填写，是不是很方便？
下面我们就来解决上面提到的与CAD的连接和通讯问题。
进入VBAIDE，按[工具]->[引用],找到可使用的引用，在“AutoCAD2000类型库”的左边打钩，点确定就行了。
在模块中输入以下代码：
GlobalSheetAsObject,acadmtextAsacadmtext,fontHightAsDouble
GlobalxlBookAsExcel.Workbook
Globalp0
（2）AsDouble,p1
（2）AsDouble,p2
（2）AsDouble
GlobalacadAppAsAcadApplication
GlobalacadDocAsAcadDocument
GlobalacadPointAsacadPoint
GlobalnumberAsInteger
PublicTypept
nAsInteger
pt
（2）AsDouble
Globalpt（）Aspt
Globaltext1AsAcadText
?
?
?
㈠?
0GlobalCADAsObject
Globalp
（2）AsDouble,iAsInteger,jAsInteger
GlobalhAsInteger,lAsInteger
PublicFunctionGet_ACAD（DwtAsString）AsBoolean
DimYERAsInteger
OnErrorResumeNext
SetacadApp=GetObject（,"AutoCAD.Application"）
IfErrThen
Err.Clear
SetacadApp=CreateObject（"AutoCAD.Application"）
IfErrThen
MsgBoxErr.Description
OnErrorGoTo0
Get_ACAD=False
ExitFunction
EndIf
EndIf
OnErrorGoTo0
SetacadDoc=acadApp.ActiveDocument
acadApp.Visible=True
Get_ACAD=True
DimtypeFaceAsString
DimBoldAsBoolean
DimItalicAsBoolean
DimcharSetAsLong
DimPitchandFamilyAsLong
acadDoc.ActiveTextStyle.GetFonttypeFace,Bold,Italic,charSet,PitchandFamily
acadDoc.ActiveTextStyle.SetFont"宋体",Bold,Italic,charSet,PitchandFamily
EndFunction
Sub显示对话框（）
Form1.Show（0）
EndSub
PublicFunctionDraw_Point（Point（）AsDouble）AsacadPoint
SetDraw_Point=acadDoc.ModelSpace.AddPoint（Point）
Draw_Point.Update
EndFunction
PublicSubSet_layer（sAsString）
DimlayerObjAsAcadLayer
SetlayerObj=acadDoc.Layers.Add（s）
acadDoc.ActiveLayer=layerObj
EndSub
再按以下模式做个对话框：
窗体的名字就叫“Form1”
双击“展点”按钮，输入以下代码：
Dimp0
（2）AsDouble,p1
（2）AsDouble,p2
（2）AsDouble
DimT1AsDouble,T2AsDouble,T3AsDouble,T4AsDouble
PublicneAsInteger,spAsSingle,czAsSingle
CallGet_ACAD（""）
DimtxtAsAcadText
DimlaAsAcadLayer
ForEachLayerInacadDoc.ModelSpace
Next
CallSet_layer（"zdh"）
SetSheet=ThisWorkbook.ActiveSheet
DimiAsInteger
DoWhileSheet.Cells（i+1,3）<>""OrSheet.Cells（i+1,1）<>""
IfSheet.Cells（i+1,3）=""OrSheet.Cells（i+1,4）=""ThenGoToII
WithSheet
p1（0）=.Cells（i+1,3）.Value
p1
（1）=.Cells（i+1,4）.Value
p1
（2）=.Cells（i+1,5）.Value
EndWith
p（0）=p1（0）
p
（1）=p1
（1）
CallSet_layer（"ZDH"）
CallDraw_Point（p1）
fontHight=TextBox5.Value
IfCells（i+1,2）=""ThenGoTooo
Settxt=acadDoc.ModelSpace.AddText（Cells（i+1,2）,p,fontHight）
txt.Color=acMagenta
oo:
IfCells（i+1,5）=""ThenGoToII
Set_layer（"GCD"）
p
（1）=p1
（1）-fontHight
Settxt=acadDoc.ModelSpace.AddText（Format（Cells（i+1,5）,"00.0"）,p,fontHight）
txt.Color=acMagenta
II:
i=i+1
Loop
EndSub
当然，你在Excel上同样可以再加个工具按钮，比如叫“展点”，指定宏为“显示对话框”，只要你的Excel有了X,Y或者X,Y，Z（格式如下表），点击“展点”就可以自动启动AutoCAD展点啦！
当然,如果AutoCAD已经启动,就直接在已经打开的AutoCAD文档中展点，展点完毕后，会显示一个对话框，提示“展点完毕“，再切换到AutoCAD看看，你所要展的点是否已经出现了？
如果没有输入错误，应该可以得到满意的结果。
如果有点号,还可以显示点号，并且可以输入字体的高度。
下面是坐标格式，其中第一列为点名，第二列为编码（可以为空），第三列为X，第四列为Y，第五列为高程。
注意，X，Y是AutoCAD的横坐标和纵坐标，与测量坐标系不同。
Excel的功能是非常强大的，如果有兴趣，你还可以在AutoCAD中直接与Excel通讯，比如一条三维多段线的所有结点的三维坐标直接导入到Excel，比在AutoCAD中用列表的方法要方便的多，限于篇幅，无法在此详细叙述了。
如果读者有兴趣，可以深入的学习和探讨。
升级会员 