哥也要装一B，向老白学习。发篇哥的关于excel的论文

BigSize

Excel VBA在工程测量上的应用
xxx
（***********************  *******   ）

摘要： excel是测量中常用的办公软件，Excel本身提供了强大的二次开发功能，本文带你走近Excel，认识它的强大的二次开发环境VBAIDE，以及VBA通过AutoCad AtiveX AutoMation信息接口对AutoCad进行操作。
关键词：自动计算 绘图 EXCEL VBA
Microsoft Excel 软件具有十分强大的制表、表格计算等功能，是普通人员常用的制表工具。可以通过其内嵌的VBA语言可以控制Microsoft Excel 的整个操作过程。  
AutoCAD是由AutoDesk公司的工程绘图软件，是CAD市场的主流产品，功能十分强大，是工程制图人员常用的软件之一。AutoDesk公司从R14版以后，为其提供了VBA语言接口。
初识VBAIDE，首先，你必须懂得一些简单的VB编程常识。如果不懂就只有通过其他的途径去学习了。但用不着深入的研究，只要静下心来，几个小时就可以了。
打开Excel，按Alt+F11即进入VBAIDE，学过VB的人一看就知道那就是熟悉的VB界面。下面看看如何定义一个函数，然后利用它来解决60进制的角度的三角函数计算问题。在菜单上依次点击[插入]¬¬¬¬->[模块]，然后输入如下代码
Public Const pi = 3.14159265359
Public Function DEG(n As Double)
Dim A As Double, B As Double, C As Double, D As Double, E As Double, F As Double, G As Double, KA As Double
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
End Function
这样，就定义了一个名字叫DEG的函数，它的作用就是转换60进制的角度为Excel认识的弧度。编辑完后按Alt+Q即返回Excel，再在某一单元格输入=sin(deg(A1))(A1既可以是单元格的值,也可以是输入的角度值),回车，哈哈，怎么样？结果出来了吧？你可以用计算器检验一下是否正确。如果出现#NAME？那就要设置一下安全设置。依次点[工具]->[宏]->[安全性]，在安全级选项卡上选择“中”或者“低”，然后关闭后重新打开就可以了，以后只要是60进制的角度，就用它转换。
工程测量中，经常碰到导线的计算，我们可以使用VBA编写一个平差程序。下面是该程序的代码：
Sub附合导线计算()
Dim m As Integer, n As Integer, ms As Double, gg As Double, sht As Object, xx As Double, yy As Double, S As Double
Set sht = ThisWorkbook.ActiveSheet
Do While sht.Cells(m + 3, 4) <> ""
m = m + 1
Loop
For n = 3 To m + 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
For n = 4 To m + 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), "######")
For n = 4 To m + 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
For n = 4 To m + 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) - sht.Cells(n, 9)
Next
    Columns("F:K").Select
    Selection.NumberFormatLocal = "0.000_ "
End Sub
Public Function RAD(Nu As Double) As Double
Dim A As Double, B As Double, C As Double, D As Double, E As Double, F As Double, G As Double, p As Double
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
End Function
　　值得注意的是，前面提到的DEG函数别忘记加进去。
如果自己定义一个名字叫“计算”的按钮，指定此工具的宏为“单一附合导线计算”，那么，只要按下面的格式输入原始数据（斜体是输入的），点“计算”就可以得到计算结果了。
下面我们就来解决上面提到的与CAD的连接和通讯问题。
进入VBAIDE，按[工具]->[引用],找到可使用的引用，在“AutoCAD2004类型库”的左边打钩，点确定就行了。在模块中输入以下代码：
Global acadapp As AcadApplication   ‘定义autocadApplication对象
Global acaddoc As AcadDocument    ‘定义autocadDocument对象
Global sheet As Object
Global xbook As Excel.Workbook
Public Function GetAcad() As Boolean  ‘定义打开autocad函数，
On Error Resume Next
Set acadapp = GetObject(, "autocad.application")
If Err Then
Err.Clear
Set acadapp = CreateObject("autocad.application")
If Err Then
MsgBox Err.Description
On Error GoTo 0
GetAcad = False
Exit Function
End If
End If
On Error GoTo 0
Set acaddoc = acadapp.ActiveDocument
acadapp.Visible = True
GetAcad = True
Dim typeFace As String
    Dim Bold As Boolean
    Dim Italic As Boolean
   Dim charSet As Long
    Dim PitchandFamily As Long
    acaddoc.ActiveTextStyle.GetFont typeFace, Bold, Italic, charSet, PitchandFamily
acaddoc.ActiveTextStyle.SetFont "宋体", Bold, Italic, charSet, PitchandFamily
End Function  ‘定义对写文字

在excel表格上添加一个“展开成图”按钮，在按钮click（）触发里写入下面代码
Private Sub CommandButton1_Click()
Call GetAcad  ‘调用打开autocad函数
Set sheet = ThisWorkbook.ActiveSheet
Dim p() As Double
Dim x As Integer
Do While sheet.Cells(x + 8, 1) <> ""
If sheet.Cells(x + 8, 1) <> "" Then x = x + 1
Loop                          ‘do while语句计算表格中要画线的点数（动态数组的个数）。
Dim xb As Integer
xb = (2 * x - 1)
ReDim p(0 To xb) As Double       ‘重新定义p数组
Dim txt As AcadText
Dim t(2) As Double
Dim i As Integer
For i = 0 To xb - 1 Step 2
With sheet
p(i) = sheet.Cells(i / 2 + 8, 7)
p(i + 1) = sheet.Cells(i / 2 + 8, 8)
t(0) = sheet.Cells(i / 2 + 8, 7)
t(1) = sheet.Cells(i / 2 + 8, 8)
t(2) = 0
End With
Set txt = acaddoc.ModelSpace.AddText(Cells(i / 2 + 8, 1), t, 3)  ‘在图中写入桩号
Next                                   ‘for 语句把excel中的数值赋值给数组p()
acaddoc.ModelSpace.AddLightWeightPolyline (p)
Dim d1(0 To 3) As Double
d1(0) = sheet.Cells(8, 7) + 2
d1(1) = sheet.Cells(8, 8)
d1(2) = sheet.Cells(9, 7) + 2
d1(3) = sheet.Cells(9, 8)
acaddoc.ModelSpace.AddLightWeightPolyline (d1)    ‘画导线复线
Dim sj(0 To 7) As Double
sj(0) = sheet.Cells(9, 7) - 4
sj(1) = sheet.Cells(9, 8) - 1.67
sj(2) = sheet.Cells(9, 7) + 6
sj(3) = sheet.Cells(9, 8) - 1.67
sj(4) = sheet.Cells(9, 7) + 1
sj(5) = sheet.Cells(9, 8) + 3.33
sj(6) = sheet.Cells(9, 7) - 4
sj(7) = sheet.Cells(9, 8) - 1.67
acaddoc.ModelSpace.AddLightWeightPolyline (sj)
Dim d2(0 To 3) As Double
d2(0) = sheet.Cells(x + 6, 7) + 2
d2(1) = sheet.Cells(x + 6, 8)
d2(2) = sheet.Cells(x + 7, 7) + 2
d2(3) = sheet.Cells(x + 7, 8)
acaddoc.ModelSpace.AddLightWeightPolyline (d2)
Dim sj1(0 To 7) As Double
sj1(0) = sheet.Cells(x + 6, 7) - 4
sj1(1) = sheet.Cells(x + 6, 8) - 1.67
sj1(2) = sheet.Cells(x + 6, 7) + 6
sj1(3) = sheet.Cells(x + 6, 8) - 1.67
sj1(4) = sheet.Cells(x + 6, 7) + 1
sj1(5) = sheet.Cells(x + 6, 8) + 3.33
sj1(6) = sheet.Cells(x + 6, 7) - 4
sj1(7) = sheet.Cells(x + 6, 8) - 1.67
acaddoc.ModelSpace.AddLightWeightPolyline (sj1)‘画导线三角形标志
ZoomAll
End Sub
本程序功能是在excel文档中，直接点击展开成图按钮，以表格中的数据在autocad中把导线画出来。其中x,y值位置在G，H列，B-47在第8行。
以上程序均在autocad 2004和excel2003中调试成功。

结束语：
　　用VBA开发的EXCEL软件，经实践证明能较好的解决目前工程算量中存在的问题。通过autocad公司提供的ActiveX atuomation信息接口，可以使用VBA操作autocad。通过modelspace对象可以对所有的线，点，标注进行操作。由于篇幅有限，不再另作介绍。希望本文起起到抛砖引玉的作用，不足之处请不吝指正。

BierTs

顶....老白从今以后是我大哥....

BierTs

如果我比他大 我就让他叫我大哥

BigSize

没有人喷，帖子不火
看来装B的功夫不到家

tezhlp44

看不懂啊

BigSize

我注释的够详细的了

aaafffei

收藏了，慢慢研究……

悲剧小公主

...看不懂

无欲则刚

装B也要装得浅显易懂啊

BigSize

原帖由 无欲则刚 于 2008-7-8 01:51 发表
装B也要装得浅显易懂啊

oh yeah
注意了

square

在EXCEL里用VB,现在是主流啊,没看出什么难得来...

benyer

专业的装B

处男

我按了ALT+F11，怎么没反应啊？

JohnnyChan

看不懂！

大长粗硬挺

这不是装B啊
如果是自己写的,确实NB的很
如果是转别人的,那起码也是转的一篇有值得学习的文章
比为装B而装B的帖子强太多了

Wu_Mengda

国妓米兰

BigSize

原帖由 Seul 于 2008-7-8 09:07 发表
比起某些人拿些肤浅的还是别人做的东西来装X

还是LZ装得让人看着舒服啊

谢谢你的赏识
哥装的还算成功吧

BigSize

05年的论文
现在这些技术基本过时了
不过还能用。

琦拉维特

收藏了...

SimoN

BigSize

旺财mm就是大方。谢了

cheng_312

好帖。

cheng_312

F = Sgn(n)
sgn是什么哦？

cheng_312

知道了。

BigSize

sign

excel内嵌函数