Excel VBA 在工程测量上的应用.docx
- 文档编号:8570897
- 上传时间:2023-01-31
- 格式:DOCX
- 页数:8
- 大小:142.79KB
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中用列表的方法要方便的多,限于篇幅,无法在此详细叙述了。
如果读者有兴趣,可以深入的学习和探讨。
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Excel VBA 在工程测量上的应用 工程 测量 应用
![提示](https://static.bdocx.com/images/bang_tan.gif)