ExcelVBA在工程测量上的应用(down)

ExcelVBA在工程测量上的应用Excel是大家很熟悉的办公软件，相信大家在工作中经常使用吧。在测量工作中，你是否感觉到有很不方便的时候？比如，计算一个角度的三角函数值，而角度的单位是60进制的，此时，你一定感到很无奈，因为，Excel本身无法直接计算60进制的角度的三角函数！还有，如果你的工作表中有了点坐标值（二维或者三维），要在CAD中展绘出来，怎样才能又快又直接？不然，就只有拐弯摸角了，很痛苦啊！其实，只要对Excel进行一些挖掘，就可以发现Excel的功能我们还没有好好的利用呢。Excel本身提供了强大的二次开发功能，只要我们仔细的研究，没有什么能难倒我们的。下面，好好笔者将带你走近Excel，认识它的强大的二次开发环境VBAIDE，用它来解决上面所提到的问题，就非常容易了。初识VBAIDE，首先，你必须懂得一些简单的VB编程常识。如果不懂就只有通过其他的途径去学习了。但用不着深入的研究，只要静下心来，几个小时就可以了。打开Excel，按Alt+F11即进入VBAIDE，学过VB的人一看就知道那就是熟悉的VB界面。下面看看如何定义一个函数，然后利用它来解决60进制的角度的三角函数计算问题。在菜单上依次点击[插入]-[模块]，然后输入如下代码PublicConstpi=3.14159265359PublicFunctionDEG(nAsDouble)DimAAsDouble,BAsDouble,CAsDouble,DAsDouble,EAsDouble,FAsDouble,GAsDouble,KAAsDoubleD=Abs(n)+0.000000000000001F=Sgn(n)A=Int(D)B=Int((D-A)*100)C=D-A-B/100DEG=F*(A+B/60+C/0.36)*pi/180EndFunction这样，就定义了一个名字叫DEG的函数，它的作用就是转换60进制的角度为Excel认识的弧度。编辑完后按Alt+Q即返回Excel，再在某一单元格输入=sin(deg(A1))(A1既可以是单元格的值,也可以是输入的角度值),回车，哈哈，怎么样？结果出来了吧？你可以用计算器检验一下是否正确。如果出现#NAME？那就要设置一下安全设置。依次点[工具]-[宏]-[安全性]，在安全级选项卡上选择“中”或者“低”，然后关闭后重新打开就可以了，以后只要是60进制的角度，就用它转换，非常方便哦。工程测量中，经常碰到导线的计算，如果手头没有平差计算程序就只有手工计算了，这时候你曾经想过编个小程序来计算？其实，这很简单，笔者在宛坪（上海至武威）高速公路上做测量监理，因为有大量的导线需要复核，故编写了一个附合导线计算程序，代码很简单，但很实用。下面是该程序的代码：Sub附合导线计算()DimmAsInteger,nAsInteger,msAsDouble,ggAsDouble,shtAsObject,xxAsDouble,yyAsDouble,SAsDoubleSetsht=ThisWorkbook.ActiveSheetDoWhilesht.Cells(m+3,4)m=m+1LoopForn=3Tom+2ms=DEG(ms)+DEG(sht.Cells(n,4))ms=RAD(ms)S=S+sht.Cells(n,3)Nextms=DEG(ms)gg=RAD(DEG(sht.Cells(3,5))+ms-DEG(sht.Cells(3+m,5))-pi*m)xx=0:yy=0Forn=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)Nextxx=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+2sht.Cells(n,8)=Format(xx/S*sht.Cells(n-1,3),###.####)sht.Cells(n,9)=Format(yy/S*sht.Cells(n-1,3),###.####)NextForn=4Tom+1sht.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)-sht.Cells(n,9)NextColumns(F:K).SelectSelection.NumberFormatLocal=0.000_EndSubPublicFunctionRAD(NuAsDouble)AsDoubleDimAAsDouble,BAsDouble,CAsDouble,DAsDouble,EAsDouble,FAsDouble,GAsDouble,pAsDoubleD=Abs(Nu)F=Sgn(Nu)p=180#/piG=p*60#A=Int(D*p)B=Int((D-A/p)*G)W=BC=(D-A/p-B/G)*20.62648062RAD=(C+A+B/100)*FEndFunction值得注意的是，前面提到的DEG函数别忘记加进去。如果自己定义一个名字叫“计算”的按钮，指定此工具的宏为“单一附合导线计算”，那么，只要按下面的格式输入原始数据（斜体是输入的），点“计算”就可以得到计算结果了。所有的过程都是自动的，无须再手工填写，是不是很方便？下面我们就来解决上面提到的与CAD的连接和通讯问题。进入VBAIDE，按[工具]-[引用],找到可使用的引用，在“AutoCAD2000类型库”的左边打钩，点确定就行了。在模块中输入以下代码：GlobalSheetAsObject,acadmtextAsacadmtext,fontHightAsDoubleGlobalxlBookAsExcel.WorkbookGlobalp0(2)AsDouble,p1(2)AsDouble,p2(2)AsDoubleGlobalacadAppAsAcadApplicationGlobalacadDocAsAcadDocumentGlobalacadPointAsacadPointGlobalnumberAsIntegerPublicTypeptnAsIntegerpt(2)AsDoubleGlobalpt()AsptGlobaltext1AsAcadTextGlobalCADAsObjectGlobalp(2)AsDouble,iAsInteger,jAsIntegerGlobalhAsInteger,lAsIntegerPublicFunctionGet_ACAD(DwtAsString)AsBooleanDimYERAsIntegerOnErrorResumeNextSetacadApp=GetObject(,AutoCAD.Application)IfErrThenErr.ClearSetacadApp=CreateObject(AutoCAD.Application)IfErrThenMsgBoxErr.DescriptionOnErrorGoTo0Get_ACAD=FalseExitFunctionEndIfEndIfOnErrorGoTo0SetacadDoc=acadApp.ActiveDocumentacadApp.Visible=TrueGet_ACAD=TrueDimtypeFaceAsStringDimBoldAsBooleanDimItalicAsBooleanDimcharSetAsLongDimPitchandFamilyAsLongacadDoc.ActiveTextStyle.GetFonttypeFace,Bold,Italic,charSet,PitchandFamilyacadDoc.ActiveTextStyle.SetFont宋体,Bold,Italic,charSet,PitchandFamilyEndFunctionSub显示对话框()Form1.Show(0)EndSubPublicFunctionDraw_Point(Point()AsDouble)AsacadPointSetDraw_Point=acadDoc.ModelSpace.AddPoint(Point)Draw_Point.UpdateEndFunctionPublicSubSet_layer(sAsString)DimlayerObjAsAcadLayerSetlayerObj=acadDoc.Layers.Add(s)acadDoc.ActiveLayer=layerObjEndSub再按以下模式做个对话框：窗体的名字就叫“Form1”双击“展点”按钮，输入以下代码：Dimp0(2)AsDouble,p1(2)AsDouble,p2(2)AsDoubleDimT1AsDouble,T2AsDouble,T3AsDouble,T4AsDoublePublicneAsInteger,spAsSingle,czAsSingleCallGet_ACAD()DimtxtAsAcadTextDimlaAsAcadLayerForEachLayerInacadDoc.ModelSpaceNextCallSet_layer(zdh)SetSheet=ThisWorkbook.ActiveSheetDimiAsIntegerDoWhileSheet.Cells(i+1,3)OrSheet.Cells(i+1,1)IfSheet.Cells(i+1,3)=OrSheet.Cells(i+1,4)=ThenGoToIIWithSheetp1(0)=.Cells(i+1,3).Valuep1(1)=.Cells(i+1,4).Valuep1(2)=.Cells(i+1,5).ValueEndWithp(0)=p1(0)p(1)=p1(1)CallSet_layer(ZDH)CallDraw_Point(p1)fontHight=TextBox5.ValueIfCells(i+1,2)=ThenGoToooSettxt=acadDoc.ModelSpace.AddText(Cells(i+1,2),p,fontHight)txt.Color=acMagentaoo:IfCells(i+1,5)=ThenGoToIISet_layer(GCD)p(1)=p1(1)-fontHightSettxt=acadDoc.ModelSpace.AddText(Format(Cells(i+1,5),00.0),p,fontHight)txt.Color=acMagentaII:i=i+1