Спасибо за выложенные макросы. Но (!!!) там не могу никак найти те функции, которые были упомянуты выше, например, функции GetDMS, DegInSign. Плохо что нет описания всех функций....
УПС... Да действительно я тоже не нахожу....
короче, похоже я перепутал версии файлов...
в общенм по позже с эти разберемся... а пока вы просто можете скопировать эти функции из форума и вставить в конеч файла...
Их декларации вместе и их описаниями находится вот в этом посте...
Почему же? Я вроде бы все функции описывал, кроме тех парраметров, что дублируют аналогичные парраметры предыдущих функций....
Ну не переживайте, документация будет, просто руки до всего сразу не доходят.. нельзя объять необъятное, даже с моим Юпитером в Деве :))) ....
И наверное со следующего апгрейда придется ввести номера версий, чтобы не было путаницы...
Последний раз редактировалось LordWilex, 10.11.2008 в 19:30.
Наверное барабашки :)
Попробуйте вставлять функции именно в конец файла (или окна с функциями, если вы это делаете напрямую в редакторе VB), возможно вы что-то заменяете при вставке или вставляете текст в середину какой-то функции....
Если вас интересуют именно эти функции попробуйте скопировать этот текст и вставить его именно в конец...
Начиная с этого поста, во избежание путаницы, вводится нумерация версий.
Так же я решил все-таки дать название проекту, а то как-то не удобно без названия :))
Теперь он называется Швейцарские эфемериды по-русски.
Название не случайно, во первых я уже несколько лет вынашиваю идею перевести документацию по ШЭ на русский язык, чтобы это дело было доступно не только англоязычным астрологам. Во вторых, давно хочу нарастить джентльменский набор функций ШЭ дополнительными возможностями (речь идет не только об использовании связки ШЭ + Excel).
Так же спешу порадовать всех, кому это интересно, что добавлена новая функция
plname(), требует она только один параметр, - достаточно ввести в неё номер планеты и она выдает её название в системе ШЭ.
Private Function set_strlen(c$) As String
i = InStr(c$, Chr$(0))
If (i > 0) Then c$ = Left(c$, i - 1)
set_strlen = c$
End Function
Public Function plname(n) As String
swe_set_ephe_path ("C:\swe\")
plnam$ = String(20, 0)
Call swe_get_planet_name(n, plnam$)
plnam$ = set_strlen(plnam$)
plnam$ = Left(plnam$, 100)
plname = plnam$
Call swe_close
End Function
Думаю, это будет полезно, если вы путаетесь в нумерации планет. Мелочь, а приятно. :)
Пример использования этой функции см. в файле, приложенном к следующему посту.
Не забудьте заменить C:\swe\ на путь, где у вас находятся эфемериды.
Работа с нестандартными фиктивными планетами в ШЭ?
Работа с нестандартными фиктивными планетами в ШЭ?
Что делать, если вашей любимой фиктивной планеты нет в Швейцарских Эфемеридах?
Две Прозерпины….
Вчера один из посетителей форума обратился ко мне с вопросом, «а куда вы, собственно говоря, дели мою любимую Прозерпину?». :)
Я с сей экзотичной планиДой ни когда не работал, но будучи уверен, что в ШЭ все есть, сначала посоветовал почитать внимательней форум, но когда внимательней поискал, все оказалось не так просто, как казалось, я обнаружил, что Прозерпины там действительно нет…
Верней я её конечно нашел, но эта Прозерпина оказалась какой-то не такой, во первых, её элементы оказались геоцентрическими, в то время, как мой знакомый уверял меня, что они должны быть геолиоцентрическими, во вторых координаты той Прозерпины, которая была в ШЭ (Ско 016° 22' 02,6953''), градусов на 5 отличались от того, что выдавала программа моего знакомого (Ско 011° 31' 50,3279'').
В общем-то если у вас имеются орбитальные элементы нужной вам фиктивной планеты, - это не проблема!
Достаточно создать файл seorbel.txt, добавить в него орбитальные элементы нужной «планеты» и поместить этот файл в папку со швейцарскими эфемеридами (или дописать элементы нужной фиктивной планеты в файл, если такой уже существует) и.. и все…
На пример, для этой самой Прозерпины, строка с орбитальными элементами будет выглядеть следующим образом (орбитальные элементы Прозерпины позаимствованы мной из программы ZET):
Где каждый элемент отделяется друг от друга запятой:
1. Эпоха относительно которой вычисляем координаты (Юлианская дата)
2. Эквоникс (Юлианская дата, либо один из этих: "J1900" или "B1950" или "J2000")
3. Средняя аномалия
4. Большая полуось орбиты
5. Экцентриситет
6. Аргумент перегелия
7. Долгота восходящего узла
8. Наклон орбиты к эклиптики
9. Название планеты
10. Если элементы геоцентрические, после названия, через запятую пишем еще и geo
Знак - '#' обозначает комментарий, после этого знака можите писать что угодно, программа это все равно не увидет :)
Для вычисления координат при помощи функции swe_calc() (в эксели функция PLC() ), используйте номер планеты
Который вычисляется по формуле:
ipl = SE_FICT_OFFSET_1 + номер элементов в этом файле. На пример, номер Крона ipl = 39 + 4 = 43
А вот и пример файла с орбитальными элементами (перевод с английского мой, прошу больно не пинать, если что не так перевелось :) ):
Если у вас проблемы с открытием файла test.xls из предыдущего поста (всплывает сообщение, что макросы были отключены из-за настроек безопасности, а координаты планет все в нулях), сделайте следующее:
1. Закройте этот файл (но не эксель :) )
2. Меню сервис -> Макрос -> Безопасность
Установите уровень безопасности на низкий (вирусов нема, фырма г'арантырует).
3. Откройте файл.
Если файл открывается, но считаются не все планеты, то:
1. Скопируйте файл seorbel.txt (он находится в архиве test.zip) в папку где у вас находятся швейцарские эфемериды
2. Зайдите в:
Меню Сервис -> Макрос -> Редактор VB -> Найдите файл test.xls -> Module1
И в текстовом окне найдите строчки
swe_set_ephe_path ("C:\swe\")
и замените C:\swe\ на путь, где у вас ШЭ
теперь точно все должно работать....
Последний раз редактировалось LordWilex, 13.11.2008 в 18:06.
Добрый всем день.
У меня все расчеты происходят в ACCESS. Эфемериды - таблицы, данные -экспортированы из ZET-а. Долгота, широта и пр. интерполируются в VBA. Закавыка в вычислении асцендента и МС. Пока не разобрался с алгоритмом ТОЧНОГО расчета. Было бы здорово если найти ссылку на это дело или мастера бы подсказали :)
Да конечно можно! :), я это как-то упустил, спасибо, что обратили внимание )))
Если честно, в ACCESS я эту систему даже не пробовал приспособить, вот все хочу приспособить это дело под open ofoce org, а времени не хватает.
По моему в эксели можно сделать все то же самое + функций на много больше, но думаю 90% функций должный работать в том числе в ACCESS, VBA он и в африке VBA , так что попробуйте вставить в модуль следующий код, если я ни чего не забыл это должно работать и в ACCESS (описание функций в этой теме выше, не забудьте скопировать swedll32.dll в windows/system и будет вам счатье, если я не вру ):
Public Declare Function swe_houses_ex Lib "swedll32.dll" _
Alias "_swe_houses_ex@40" ( _
ByVal tjd_ut As Double, _
ByVal iflag As Long, _
ByVal geolat As Double, _
ByVal geolon As Double, _
ByVal ihsy As Long, _
ByRef hcusps As Double, _
ByRef ascmc As Double _
) As Long ' hcusps must be first of 13 array elements
' ascmc must be first of 10 array elements
Const SEFLG_JPLEPH As Long = 1
Const SEFLG_SWIEPH As Long = 2
Const SEFLG_MOSEPH As Long = 4
Const SEFLG_SPEED As Long = 256
Const SEFLG_HELCTR As Long = 8
Const SEFLG_TRUEPOS As Long = 16
Const SEFLG_J2000 As Long = 32
Const SEFLG_NONUT As Long = 64
Const SEFLG_NOGDEFL As Long = 512
Const SEFLG_NOABERR As Long = 1024
Const SEFLG_EQUATORIAL As Long = 2048
Const SEFLG_XYZ As Long = 4096
Const SEFLG_RADIANS As Long = 8192
Const SEFLG_BARYCTR As Long = 16384
Const SEFLG_TOPOCTR As Long = 32768
Const SEFLG_SIDEREAL As Long = 65536
Public Function PlHouse(ByVal JD As Double, ByVal pl As Double, ByVal HSys As Variant, ByVal CType As Variant, ByVal LonH As Double, ByVal LonM As Double, ByVal LatH As Double, ByVal LatM As Double)
Dim cspx(12) As Double
Dim csph(12) As Double
Dim Lpl As Double
For i = 1 To 12
cspx(i) = CHouse(JD, HSys, CType, i, LonH, LonM, LatH, LatM)
Next
For i = 1 To 12
csph(i) = StartPoint(cspx(1), cspx(i))
Next
Lpl = StartPoint(cspx(1), Plc(JD, pl, CType, 0))
PlHouse = 1
For i = 2 To 12
If Lpl > csph(i) Then PlHouse = i
Next
End Function
Public Function CHouse(ByVal JD As Double, ByVal HSys As Variant, ByVal CType As Variant, ByVal csp As Integer, ByVal LonH As Double, ByVal LonM As Double, ByVal LatH As Double, ByVal LatM As Double)
Dim x(6) As Double
Dim cusp(13) As Double
Dim ascmc(10) As Double
Call SweInit
iflag = SEFLG_SPEED + SEFLG_MOSEPH
If CType = "SSid" Or CType = "MSid" Then iflag = SEFLG_SPEED + SEFLG_MOSEPH + SEFLG_SIDEREAL
' Øâåéöàðñêèå ýôåìåðèäû
If CType = "STrop" Then iflag = SEFLG_TRUEPOS + SEFLG_SWIEPH
If CType = "SSid" Then iflag = SEFLG_SIDEREAL + SEFLG_SWIEPH
If CType = "SHel" Then iflag = SEFLG_HELCTR + SEFLG_SWIEPH
If CType = "SXYZ" Then iflag = SEFLG_XYZ + SEFLG_SWIEPH
If CType = "SRad" Then iflag = SEFLG_RADIANS + SEFLG_SWIEPH
If CType = "SEq" Then iflag = SEFLG_EQUATORIAL + SEFLG_SWIEPH
If CType = "SEqR" Then iflag = SEFLG_RADIANS + SEFLG_EQUATORIAL + SEFLG_SWIEPH
' Ýôåìåðèäû Ìîøüåðà
If CType = "MTrop" Then iflag = SEFLG_TRUEPOS + SEFLG_MOSEPH
If CType = "MSid" Then iflag = SEFLG_SIDEREAL + SEFLG_MOSEPH
If CType = "MHel" Then iflag = SEFLG_HELCTR + SEFLG_MOSEPH
If CType = "MXYZ" Then iflag = SEFLG_XYZ + SEFLG_MOSEPH
If CType = "MRad" Then iflag = SEFLG_RADIANS + SEFLG_MOSEPH
If CType = "MEq" Then iflag = SEFLG_EQUATORIAL + SEFLG_MOSEPH
If CType = "MEqR" Then iflag = SEFLG_RADIANS + SEFLG_EQUATORIAL + SEFLG_MOSEPH
' JPL ýôåìåðèäû (DE406)
If CType = "JTrop" Then iflag = SEFLG_TRUEPOS + SEFLG_JPLEPH
If CType = "JSid" Then iflag = SEFLG_SIDEREAL + SEFLG_JPLEPH
If CType = "JHel" Then iflag = SEFLG_HELCTR + SEFLG_JPLEPH
If CType = "JXYZ" Then iflag = SEFLG_XYZ + SEFLG_JPLEPH
If CType = "JRad" Then iflag = SEFLG_RADIANS + SEFLG_JPLEPH
If CType = "JEq" Then iflag = SEFLG_EQUATORIAL + SEFLG_JPLEPH
If CType = "JEqR" Then iflag = SEFLG_RADIANS + SEFLG_EQUATORIAL + SEFLG_JPLEPH
lon = LonH + 1 / 60 * LonM
Lat = LatH + 1 / 60 * LatM
asss = swe_houses_ex(JD, iflag, lon, Lat, Asc(HSys), cusp(0), ascmc(0))
If csp < 13 Then CHouse = cusp(csp) Else CHouse = ascmc(csp - 13)
End Function
Public Function FixY(ByVal x As Double, ByVal y As Double)
' Ñîõðàíÿåò êîîðäèíàòó ïëàíåòû x â äèàïàçàíå y
While x >= y
x = x - y
Wend
While x < 0
x = x + y
Wend
FixY = x
End Function
Public Function StartPoint(SPoint, pl)
Dim d As Double
d = pl - SPoint
If d < 0 Then d = d + 360
If d > 360 Then d = d - 360
StartPoint = d
'StartPoint = FixY(swe_difdeg2n(pl, SPoint) + 360, 360)
End Function
Спасибо. Уже изучаю первоисточник. Классная вещь.
____
У Вас в программах кое где не объявляются явно внутренние переменные. Это значит (раз ошибок компилятор не выдает) не задан параметр "Option explicit" в заголовке модуля. Советую задать, чтобы не налететь на случайную ошибку.
Приятно слышать ))
Я так понимаю, вы подключили таки ШЭ к ACCESS ?
Если да, не могли бы воложить примерчик, а то я к ACCESS ни когда это дело не пытался подключить, интересно как оно работает в действии.
В Zet8: Moon = 29 55 22 Скорпион
Solar= 29 29 6 Водолей
Да и с широтой что-то не то. А значит асцендент уедет конкретно.
Расхождение слишком большое. Будем разбираться.
VBA аналогичен в EXEL и ACCESS.
Пример:
Код:
Public Function getPlanParametrs(dt As Date, planStruct As planetarParametr, ipl As Integer, isGeo As Boolean, lonSource As Double, latSource As Double) As String
Dim jd As Double, s As String, isOk As Long, iflag As Long, xx(0 To 5) As Double
swe_set_ephe_path EPHEMERIDES_PATH
planStruct.ipl = ipl
getPlanParametrs = ""
s = String(300, " ") ' для подстраховки от API проблем
jd = getJulianDay(year(dt), month(dt), day(dt), hour(dt), Minute(dt), Second(dt), 1)
swe_set_topo lonSource, latSource, 2#
iflag = SEFLG_TOPOCTR + SEFLG_TRUEPOS + SEFLG_SWIEPH + IIf(isGeo, 0, SEFLG_HELCTR)
isOk = swe_calc_ut(jd, ipl, iflag, xx(0), s)
planStruct.lon = xx(0)
planStruct.lat = xx(1)
planStruct.dist = xx(2)
planStruct.speedLon = xx(3)
planStruct.speedLat = xx(4)
planStruct.speedDist = xx(5)
If isOk <> iflag Then getPlanParametrs = "Err: " & s
End Function
Это тестовая функция. Получает дату, структуру типа planetarParametr (сам назначил), ipl - планета, isGeo - гео или гелио, lonSource - долгота места откуда смотрим,
latSource -широта места.
EPHEMERIDES_PATH - путь к эфемеридам.
___________
Добавка: видимо дело в разнице во времени +03 ч. для питера
Только непонятно почему ? Выставляю на питер и там и там. Получается что прога считает только в гринвиче.
Тогда расхождение маленькое: Solar - 22 секунды дуги.
Moon - 14 минут дуги.
Последний раз редактировалось solar, 17.02.2009 в 02:19.
Да эта штука пока считает только по гринвичу, не доходят руки сделать функцию по переводу в местное время...
Да оно и удобней сразу вбить данные по гринвичу, и не париться.
Нет расхождений даже в 22 секунды быть не должно...
Может быть у вас или в зет или в макросе все-таки подключены эфемериды мойшера?
Дело в том, что когда в коде какой-то сбой автоматом считается именно по ним...
Ну если у вас задача не связанно со статистикой, то в принципе нормально, работать можно!
А вот в статистике и 2 секунды ошибки иногда много решают...
Все таки у меня подозрения, что у вас почему-то идет автоматическое переключение на Мошьеровские эфемериды, именно они дают расхождение с ШЭ и JPL такого порядка...
Анекдот. Невязка вызвана тем, что я сначала определял дату в Zet, а затем запускал тест. Разница во времени выполнения этих операций и дала крохотное смещение :)
А эфемериды швейц. - проверил.
):
Линейный вид
