方位角计算VB源代码

'定义角度输出格式（枚举类型）

Enum rtnAzimuthFormat
qd_DecimalDegree
qd_DD_MM_SS_SeperatedByMinusSymbol
qd_DD_MM_SS_SeperatedByDivideSymbol
qd_Decimal_DD_MM_SS
End Enum

'（二维）点格式

Public Type Point
X As Double
Y As Double
End Type

'方位角计算

'调用方法：

'rtnAz=surAzimuth(起始点，终点，返回格式，度（可选），分（可选），秒（可选））

'度（可选）表示只输出DD-MM-SS中的度部分，便于后续处理
Public function surAzimuth(PointA As Point, PointB As Point, rtnFormat As rtnAzimuthFormat, Optional Degree As Integer, Optional Minute As Integer, Optional Second As Single) As String
Dim deltX As Double, deltY As Double
Dim AziCal As Double
Dim pi As Double
Dim intD As Integer, intM As Integer, Sec As Single, mm As Single
pi = Atn(1) * 4

deltX = PointB.X - PointA.X
deltY = PointB.Y - PointA.Y + 1E-20

AziCal = (pi - pi / 2 * Sgn(deltY) - Atn(deltX / deltY)) * 180 / pi

intD = Int(AziCal)
mm = (AziCal - intD) * 60#
intM = Int(mm)
Sec = Round((mm - intM) * 60, 2)

Degree = intD
Minute = intM
Second = Sec

Select Case rtnFormat
Case qd_DecimalDegree
surAzimuth = AziCal
Case qd_DD_MM_SS_SeperatedByMinusSymbol
surAzimuth = Format(intD, "0") & "-" & Format(intM, "00") & "-" & Format(Sec, "0.00")
Case qd_DD_MM_SS_SeperatedByDivideSymbol
surAzimuth = Format(intD, "0") & "/" & Format(intM, "00") & "/" & Format(Sec, "0.00")
Case qd_Decimal_DD_MM_SS
surAzimuth = Format(intD, "0") & "." & Format(intM, "00") & Format(Sec * 100, "00")
Case Else
surAzimuth = AziCal
End Select

End function

该代码可在VB程序或Excel、AutoCAD的VBA程序中使用，直接拷进去，调用函数即可。

相关文章