EXCELVBA支导线测量计算程序

原始数据表格:

计算后数据表格:

Sub 测量支导线计算()
'''2008-10-10
Dim Pi As Double
Pi = 3.14159265358979
Dim xa As Double, ya As Double, xb As Double, yb As Double, yy As Double, xx As Double
Dim AA As Double, dd As Double, jiajiao As Double
Dim radfangweijiao As Double, degfangweijiao As Double

Dim hangnum As Integer
i = 0
xa = Application.Cells(5, 9).Value
ya = Application.Cells(5, 10).Value
xb = Application.Cells(4, 9).Value
yb = Application.Cells(4, 10).Value

yy = ya - yb
xx = xa - xb
dd = Sqr(yy ^ 2 + xx ^ 2)

AA = Atn(yy / xx)

If xx < 0 Then AA = AA + Pi

If xx > 0 And yy < 0 Then AA = AA + 2 * Pi

Application.Cells(5, 6).Value = dd
Application.Cells(5, 5).Value = AA
Application.Cells(5, 3).Value = Radtodeg(AA)

For i = 6 To 50 ''观测角度转换为弧度
   jiajiao = Application.Cells(i, 2).Value
   hangnum = i
   If jiajiao = 0 Then Exit For
   Application.Cells(i, 4).Value = degtoRad(jiajiao)
Next i
For i = 6 To hangnum - 1 ''弧度方位角计算
 radfangweijiao = Application.Cells(i - 1, 5).Value + Application.Cells(i, 4).Value + Pi
 If radfangweijiao > 2 * Pi Then radfangweijiao = radfangweijiao - 2 * Pi
 Application.Cells(i, 5).Value = radfangweijiao
Next i
For i = 6 To hangnum - 1 ''弧度方位角转变为角度方位角
 radfangweijiao = Application.Cells(i, 5).Value
 Application.Cells(i, 3).Value = Radtodeg(radfangweijiao)
Next i

For i = 6 To hangnum - 1 ''计算XY坐标
 Application.Cells(i, 9).Value = Application.Cells(i - 1, 9).Value + Round(Application.Cells(i, 6).Value * Cos(Application.Cells(i, 5).Value), 4) '''''X
 Application.Cells(i, 10).Value = Application.Cells(i - 1, 10).Value + Round(Application.Cells(i, 6).Value * Sin(Application.Cells(i, 5).Value), 4) '''''y

Next
For i = 6 To hangnum - 1 ''计算增量X''''''增量y
 Application.Cells(i, 7).Value = Round(Application.Cells(i, 6).Value * Cos(Application.Cells(i, 5).Value), 4)  '''''增量X
 Application.Cells(i, 8).Value = Round(Application.Cells(i, 6).Value * Sin(Application.Cells(i, 5).Value), 4) ''''''增量y

Next

End Sub
Public Function Radtodeg(ByVal radian As Double) As String ' 弧度转换为角度“如100°00′00 ″
Dim radDEG As Double
radDEG = 57.2957795130823

Dim A As Double, B As Double, C As Double, D As Double, e As Double
Dim ang As Double, sign As Integer
ang = Abs(radian) + 0.00000000000001: sign = Sgn(radian): A = ang * radDEG
B = Int(A): C = (A - B) * 60: D = Int(C): e = (C - D) * 60
Radtodeg = Str$(sign * B) & "°" & Format$("00", D) & "′" & Str$(Round(e, 2)) & "″"

End Function

 
Public Function degtoRad(ByVal angle As Double) As Double '“100.1010”角度转换为弧度
 M_RAD# = 1.74532925199433E-02
Dim A As Double, B As Double, C As Double, D As Double
Dim ang As Double, sign As Integer
ang = Abs(angle) + 0.0000000000001: sign = Sgn(angle)
A = Int(ang): B = (ang - A) * 100#: C = Int(B): D = (B - C) * 100#
degtoRad = sign * (A + C / 60# + D / 3600#) * M_RAD
End Function