Excel VBA在工程测量上的应用Word文档下载推荐.docx

Excel VBA在工程测量上的应用Word文档下载推荐.docx

《Excel VBA在工程测量上的应用Word文档下载推荐.docx》由会员分享，可在线阅读，更多相关《Excel VBA在工程测量上的应用Word文档下载推荐.docx（8页珍藏版）》请在冰豆网上搜索。

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）

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）,"

######"

sht.Cells（n,8）=Format（xx/S*sht.Cells（n-1,3）,"

###.####"

sht.Cells（n,9）=Format（yy/S*sht.Cells（n-1,3）,"

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）

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

值得注意的是，前面提到的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（"

MsgBoxErr.Description

OnErrorGoTo0

Get_ACAD=False

ExitFunction

EndIf

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

Sub显示对话框（）

Form1.Show（0）

PublicFunctionDraw_Point（Point（）AsDouble）AsacadPoint

SetDraw_Point=acadDoc.ModelSpace.AddPoint（Point）

Draw_Point.Update

PublicSubSet_layer（sAsString）

DimlayerObjAsAcadLayer

SetlayerObj=acadDoc.Layers.Add（s）

acadDoc.ActiveLayer=layerObj

再按以下模式做个对话框：

窗体的名字就叫“Form1”

双击“展点”按钮，输入以下代码：

Dimp0

（2）AsDouble,p1

（2）AsDouble,p2

（2）AsDouble

DimT1AsDouble,T2AsDouble,T3AsDouble,T4AsDouble

PublicneAsInteger,spAsSingle,czAsSingle

CallGet_ACAD（"

DimtxtAsAcadText

DimlaAsAcadLayer

ForEachLayerInacadDoc.ModelSpace

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）

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）="

Set_layer（"

GCD"

p

（1）=p1

（1）-fontHight

Settxt=acadDoc.ModelSpace.AddText（Format（Cells（i+1,5）,"

00.0"

）,p,fontHight）

II:

i=i+1

当然，你在Excel上同样可以再加个工具按钮，比如叫“展点”，指定宏为“显示对话框”，只要你的Excel有了X,Y或者X,Y，Z（格式如下表），点击“展点”就可以自动启动AutoCAD展点啦！

当然,如果AutoCAD已经启动,就直接在已经打开的AutoCAD文档中展点，展点完毕后，会显示一个对话框，提示“展点完毕“，再切换到AutoCAD看看，你所要展的点是否已经出现了？

如果没有输入错误，应该可以得到满意的结果。

如果有点号,还可以显示点号，并且可以输入字体的高度。

下面是坐标格式，其中第一列为点名，第二列为编码（可以为空），第三列为X，第四列为Y，第五列为高程。

注意，X，Y是AutoCAD的横坐标和纵坐标，与测量坐标系不同。

Excel的功能是非常强大的，如果有兴趣，你还可以在AutoCAD中直接与Excel通讯，比如一条三维多段线的所有结点的三维坐标直接导入到Excel，比在AutoCAD中用列表的方法要方便的多，限于篇幅，无法在此详细叙述了。

如果读者有兴趣，可以深入的学习和探讨。