'（二維）點(diǎn)格式

Public Type Point
X As Double
Y As Double
End Type

'方位角計(jì)算

'調(diào)用方法：

'rtnAz=surAzimuth(起始點(diǎn)，終點(diǎn)，返回格式，度（可選），分（可選），秒（可選））

'度（可選）表示只輸出DD-MM-SS中的度部分，便于后續(xù)處理
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程序中使用，直接拷進(jìn)去，調(diào)用函數(shù)即可。