Option Explicit
Sub CalculateAscendant()
Dim birthDate As Date
Dim birthTime As Date
Dim birthPlace As String
Dim birthLat As Double
Dim birthLong As Double
Dim asc As Double
birthDate = InputBox("Enter your birth date (MM/DD/YYYY):")
birthTime = InputBox("Enter your birth time (HH:MM AM/PM):")
birthPlace = InputBox("Enter your birth place (City, State, Country):")
birthLat = GetLatitude(birthPlace)
birthLong = GetLongitude(birthPlace)
asc = CalculatePlacidusAscendant(birthDate, birthTime, birthLat, birthLong)
MsgBox "Your Ascendant is " & FormatDegree(asc)
End Sub
Function GetLatitude(place As String) As Double
Dim latScript As String
Dim latResult As Variant
Dim lat As Double
latScript = "set placeName to """ & place & """ as text" & vbNewLine
latScript = latScript & "tell application ""Maps""" & vbNewLine
latScript = latScript & "set thePlace to first item of (search the current map for placeName)" & vbNewLine
latScript = latScript & "set theLat to latitude of thePlace" & vbNewLine
latScript = latScript & "end tell" & vbNewLine
latScript = latScript & "return theLat"
latResult = Evaluate("APPLESCRIPT(" & Chr(34) & latScript & Chr(34) & ")")
lat = CDbl(latResult)
GetLatitude = lat
End Function
Function GetLongitude(place As String) As Double
Dim longScript As String
Dim longResult As Variant
Dim lang As Double
longScript = "set myAddress to """ & place & """" & vbNewLine & _
"tell application ""Maps""" & vbNewLine & _
" set myLocation to get location of first item of (get every result whose name contains myAddress)" & vbNewLine & _
" return longitude of myLocation" & vbNewLine & _
"end tell"
longResult = Run("osascript -e " & Chr(34) & longScript & Chr(34))
If IsNumeric(longResult) Then
lang = CDbl(longResult)
Else
lang = 0
End If
GetLongitude = lang
End Function
Function CalculatePlacidusAscendant(birthDate As Date, birthTime As Date, birthLat As Double, birthLong As Double) As Double
Dim birthDateTime As Double
Dim jd As Double
Dim t As Double
Dim obliq As Double
Dim lst As Double
Dim e As Double
Dim d As Double
Dim oblCor As Double
Dim ascmc(10) As Double
Dim armc As Double
Dim eps As Double
Dim sid As Double
Dim i As Integer
birthDateTime = CDbl(birthDate + TimeSerial(Hour(birthTime), minute(birthTime), second(birthTime)))
jd = JulianDate(birthDateTime)
t = (jd - 2451545) / 36525
obliq = Obliquity(t)
lst = LocalSiderealTime(birthLong, jd)
e = obliq + (0.00256 * Cos(Radians(125.04 - (1934.136 * t))))
d = -1 * (0.00017 * Sin(Radians(125.04 - (1934.136 * t))))
oblCor = obliq + e + d
ascmc(0) = 0
CalculatePlacidusAscendant = ascmc(1)
For i = 1 To 10
ascmc(i) = EclipticPosition(jd, (i - 1) * 30, birthLat, birthLong, lst, oblCor)
Next i
End Function
Function FormatDegree(angle As Double) As String
Dim degree As Integer
Dim minute As Integer
Dim second As Double
degree = Int(angle)
minute = Int((angle - degree) * 60)
second = ((angle - degree - minute / 60) * 3600)
FormatDegree = Format(degree, "00") & "°" & Format(minute, "00") & "'" & Format(second, "00.00") & """"
End Function