Вернуться   Астрологические форумы ARGO > Делимся информацией. Тестируем астрологию. Прогнозируем. > Астрологические программы

Ответ
 
Опции темы Опции просмотра
Старый 10.11.2008, 18:14   #41
serguccio
Собеседник
 
Регистрация: 23.12.2007
Сообщения: 11
serguccio репутация выше +10
По умолчанию

Спасибо за выложенные макросы. Но (!!!) там не могу никак найти те функции, которые были упомянуты выше, например, функции GetDMS, DegInSign. Плохо что нет описания всех функций....
serguccio вне форума   Ответить с цитированием
Старый 10.11.2008, 19:21   #42
LordWilex
В отпуске
 
Аватар для LordWilex
 
Регистрация: 01.06.2008
Адрес: Таганрог
Сообщения: 28,983
LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250
По умолчанию

Цитата:
Сообщение от serguccio
Спасибо за выложенные макросы. Но (!!!) там не могу никак найти те функции, которые были упомянуты выше, например, функции GetDMS, DegInSign.
УПС... Да действительно я тоже не нахожу....
короче, похоже я перепутал версии файлов...
в общенм по позже с эти разберемся... а пока вы просто можете скопировать эти функции из форума и вставить в конеч файла...

Их декларации вместе и их описаниями находится вот в этом посте...

Цитата:
Сообщение от serguccio
Плохо что нет описания всех функций....

Почему же? Я вроде бы все функции описывал, кроме тех парраметров, что дублируют аналогичные парраметры предыдущих функций....

Ну не переживайте, документация будет, просто руки до всего сразу не доходят.. нельзя объять необъятное, даже с моим Юпитером в Деве :))) ....
И наверное со следующего апгрейда придется ввести номера версий, чтобы не было путаницы...

Последний раз редактировалось LordWilex, 10.11.2008 в 19:30.
LordWilex вне форума   Ответить с цитированием
Старый 10.11.2008, 19:37   #43
serguccio
Собеседник
 
Регистрация: 23.12.2007
Сообщения: 11
serguccio репутация выше +10
По умолчанию

Я пробовал копировать с сайта, почему то когда все скопируешь у меня исчезает в выборе функция перевода в юлианскую дату :-( Куда девается....?
serguccio вне форума   Ответить с цитированием
Старый 10.11.2008, 21:08   #44
LordWilex
В отпуске
 
Аватар для LordWilex
 
Регистрация: 01.06.2008
Адрес: Таганрог
Сообщения: 28,983
LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250
По умолчанию

Цитата:
Сообщение от serguccio
Я пробовал копировать с сайта, почему то когда все скопируешь у меня исчезает в выборе функция перевода в юлианскую дату :-( Куда девается....?

Наверное барабашки :)
Попробуйте вставлять функции именно в конец файла (или окна с функциями, если вы это делаете напрямую в редакторе VB), возможно вы что-то заменяете при вставке или вставляете текст в середину какой-то функции....

Если вас интересуют именно эти функции попробуйте скопировать этот текст и вставить его именно в конец...

Цитата:
Public Function GetDMS(ByVal Deg As Double, Optional ByVal par As Variant) As String
fract = Abs(Deg) - Int(Abs(Deg))
min = Int(fract * 60)
sec = fract * 3600 - min * 60
GetDMS = Format(Sgn(Deg) * Int(Abs(Deg)), "000") + "° " + Format(min, "00") + "' " + Format(sec, "00.0000") + "''"
If par = 1 Or par = "grad" Then GetDMS = Format(Sgn(Deg) * Int(Abs(Deg)), "000")
If par = 2 Or par = "min" Then GetDMS = Format(min, "00")
If par = 3 Or par = "sec" Then GetDMS = Format(sec, "00.0000") + "''"
End Function

Public Function DegInSign(x As Double)
DegInSign = x - (Fix(x / (360 / 12)) * 30)
End Function
LordWilex вне форума   Ответить с цитированием
Старый 11.11.2008, 18:17   #45
serguccio
Собеседник
 
Регистрация: 23.12.2007
Сообщения: 11
serguccio репутация выше +10
Wink

EHHHHFFFFF!!!!! ЗАРАБОТАЛООООО
serguccio вне форума   Ответить с цитированием
Старый 11.11.2008, 18:18   #46
serguccio
Собеседник
 
Регистрация: 23.12.2007
Сообщения: 11
serguccio репутация выше +10
По умолчанию

УРРРРРАААААААА!!!!!!!!!!! ЗАРАБОТАЛООООО!!!!! :-)
serguccio вне форума   Ответить с цитированием
Старый 13.11.2008, 14:06   #47
LordWilex
В отпуске
 
Аватар для LordWilex
 
Регистрация: 01.06.2008
Адрес: Таганрог
Сообщения: 28,983
LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250
По умолчанию Швейцарские Эфемериды по-русски - Версия 1.0.

Швейцарские Эфемериды по-русски - Версия 1.0.

Во первых, как и обещал, выкладываю полную версию файла с функциями в текстовом формате, а так же в формате XLA.

Скачать текстовую версию: SweRuTXT.zip
Скачать XLA версию: SweRuXLA.zip

Начиная с этого поста, во избежание путаницы, вводится нумерация версий.

Так же я решил все-таки дать название проекту, а то как-то не удобно без названия :))
Теперь он называется Швейцарские эфемериды по-русски.
Название не случайно, во первых я уже несколько лет вынашиваю идею перевести документацию по ШЭ на русский язык, чтобы это дело было доступно не только англоязычным астрологам. Во вторых, давно хочу нарастить джентльменский набор функций ШЭ дополнительными возможностями (речь идет не только об использовании связки ШЭ + 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\ на путь, где у вас находятся эфемериды.
LordWilex вне форума   Ответить с цитированием
Старый 13.11.2008, 14:10   #48
LordWilex
В отпуске
 
Аватар для LordWilex
 
Регистрация: 01.06.2008
Адрес: Таганрог
Сообщения: 28,983
LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250
По умолчанию Работа с нестандартными фиктивными планетами в ШЭ?

Работа с нестандартными фиктивными планетами в ШЭ?
Что делать, если вашей любимой фиктивной планеты нет в Швейцарских Эфемеридах?

Две Прозерпины….
Вчера один из посетителей форума обратился ко мне с вопросом, «а куда вы, собственно говоря, дели мою любимую Прозерпину?». :)
Я с сей экзотичной планиДой ни когда не работал, но будучи уверен, что в ШЭ все есть, сначала посоветовал почитать внимательней форум, но когда внимательней поискал, все оказалось не так просто, как казалось, я обнаружил, что Прозерпины там действительно нет…
Верней я её конечно нашел, но эта Прозерпина оказалась какой-то не такой, во первых, её элементы оказались геоцентрическими, в то время, как мой знакомый уверял меня, что они должны быть геолиоцентрическими, во вторых координаты той Прозерпины, которая была в ШЭ (Ско 016° 22' 02,6953''), градусов на 5 отличались от того, что выдавала программа моего знакомого (Ско 011° 31' 50,3279'').

В общем-то если у вас имеются орбитальные элементы нужной вам фиктивной планеты, - это не проблема!
Достаточно создать файл seorbel.txt, добавить в него орбитальные элементы нужной «планеты» и поместить этот файл в папку со швейцарскими эфемеридами (или дописать элементы нужной фиктивной планеты в файл, если такой уже существует) и.. и все…

На пример, для этой самой Прозерпины, строка с орбитальными элементами будет выглядеть следующим образом (орбитальные элементы Прозерпины позаимствованы мной из программы ZET):

2445375.5, 2445375.5, 187.502320, 77.926077235, 0.08550236, 319.538004, 63.696644, 3.000799, Прозерпина # 19 (PLC = 59)

Где каждый элемент отделяется друг от друга запятой:

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

А вот и пример файла с орбитальными элементами (перевод с английского мой, прошу больно не пинать, если что не так перевелось :) ):

Цитата:
# Орбитальные элементы фиктивных планет
# 27 Jan. 2000
#
# Этот файл является частью Швейцарских Эфемерид, версии 1.52.
# Пользователь может добавить свои собственные фиктивные планеты (максимум 960 планет).
#
# Порядок элементов в строке следующий:
# 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
#
# Транснептуны ГША, по данным Джейма Нили (James Neely)
J1900, J1900, 163.7409, 40.99837, 0.00460, 171.4333, 129.8325, 1.0833, Купидон # 1 (PLC = 40)
J1900, J1900, 27.6496, 50.66744, 0.00245, 148.1796, 161.3339, 1.0500, Гадес # 2 (PLC = 41)
J1900, J1900, 165.1232, 59.21436, 0.00120, 299.0440, 0.0000, 0.0000, Зевс # 3 (PLC = 42)
J1900, J1900, 169.0193, 64.81960, 0.00305, 208.8801, 0.0000, 0.0000, Крон # 4 (PLC = 43)
J1900, J1900, 138.0533, 70.29949, 0.00000, 0.0000, 0.0000, 0.0000, Апплалон # 5 (PLC = 44)
J1900, J1900, 351.3350, 73.62765, 0.00000, 0.0000, 0.0000, 0.0000, Адмет # 6 (PLC = 45)
J1900, J1900, 55.8983, 77.25568, 0.00000, 0.0000, 0.0000, 0.0000, Вулкан # 7 (PLC = 46)
J1900, J1900, 165.5163, 83.66907, 0.00000, 0.0000, 0.0000, 0.0000, Посейдон # 8 (PLC = 47)
#
# Изида трансплутоновая "Die Sterne" 3/1952, p. 70ff.
2368547.66, 2431456.5, 0.0, 77.775, 0.3, 0.7, 0, 0, Isis-Transpluto # 9 (PLC = 48)
# Нибиру элементы по Криятьяну Уолтегу (Christian Woeltge)
1856113.380954, 1856113.380954, 0.0, 234.8921, 0.981092, 103.966, -44.567, 158.708, Нибиру # 10 (PLC = 49)
# 10-я планета по Харингтону (Harrington), по данным Astronomical Journal 96(4), Oct. 1988
2374696.5, J2000, 0.0, 101.2, 0.411, 208.5, 275.4, 32.4, Harrington # 11 (PLC = 50)
# Другие попытки найти 10-ю "планету - X" по данным W.G. Hoyt, "Planets X and Pluto", Tucson 1980, p. 63
2395662.5, 2395662.5, 34.05, 36.15, 0.10761, 284.75, 0, 0, Leverrier (Neptune) # 12 (PLC = 51)
2395662.5, 2395662.5, 24.28, 37.25, 0.12062, 299.11, 0, 0, Adams (Neptune) # 13 (PLC = 52)
2425977.5, 2425977.5, 281, 43.0, 0.202, 204.9, 0, 0, Lowell (Pluto) # 14 (PLC = 53)
2425977.5, 2425977.5, 48.95, 55.1, 0.31, 280.1, 100, 15, Pickering (Pluto) # 15 (PLC = 54)
# Вулкан (интромеркуриарный :) ) по данным Л. Уестона (L.H. Weston)
J1900,JDATE, 252.8987988 + 707550.7341 * T, 0.13744, 0.019, 322.212069+1670.056*T, 47.787931-1670.056*T, 7.5, Vulcan # 16 (PLC = 55)
# Селена / Белая луна
J2000,JDATE, 242.2205555 + 5143.5418158 * T, 0.05280098949, 0.0, 0.0, 0.0, 0.0, Selena/White Moon, geo # 17 (PLC = 56)
# Прозерпина, по данным http://www.geocities.com/Hollywood/A...roserpina.html
# J1900, 170.73 + 51.05 * T
J1900,JDATE, 170.73, 79.225630, 0, 0, 0, 0, Proserpina (гео) #18 (PLC = 57)
# Вторая Луна по Уальдемату (Waldemath's Second Earth Moon)
2414290.95827875,2414290.95827875, 70.3407215 + 109023.2634989 * T, 0.0068400705250028, 0.1587, 8.14049594 + 2393.47417444 * T, 136.24878256 - 1131.71719709 * T, 2.5, Waldemath, geo # 19 (PLC = 58)
######################################## ######
### Дополнительные элементы
# Прозерпина по элементам, позаимствованным из программы ZET
2445375.5, 2445375.5, 187.502320, 77.926077235, 0.08550236, 319.538004, 63.696644, 3.000799, Прозерпина # 19 (PLC = 59)
# Дхарма по элементам, позаимствованным из программы ZET
2448830.500, 2448830.500, 050.7800, 57.839761679, 0.11800000, 288.017908, 047.587053, 2.500595, Дхарма # 20 (PLC = 60)


Работающий пример можно скачать тут: test.zip .

Последний раз редактировалось LordWilex, 13.11.2008 в 14:14.
LordWilex вне форума   Ответить с цитированием
Старый 13.11.2008, 17:59   #49
LordWilex
В отпуске
 
Аватар для LordWilex
 
Регистрация: 01.06.2008
Адрес: Таганрог
Сообщения: 28,983
LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250
По умолчанию

Если у вас проблемы с открытием файла 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.
LordWilex вне форума   Ответить с цитированием
Старый 30.01.2009, 20:55   #50
Алексей
Собеседник
 
Аватар для Алексей
 
Регистрация: 01.11.2007
Сообщения: 8,437
Алексей репутация выше +2000Алексей репутация выше +2000Алексей репутация выше +2000Алексей репутация выше +2000Алексей репутация выше +2000Алексей репутация выше +2000Алексей репутация выше +2000Алексей репутация выше +2000Алексей репутация выше +2000Алексей репутация выше +2000Алексей репутация выше +2000
По умолчанию

Цитата:
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), CHouse(JD, HSys, CType, i, LonH, LonM, LatH, LatM))
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

Увидел, что идет повторный вызов функции CHouse с теми же аргументами при заполнении массива csph.

Может быть эту строку можно упростить и привести к такому виду:

csph(i) = StartPoint(cspx(1),cspx(i))
Алексей вне форума   Ответить с цитированием
Старый 02.02.2009, 22:03   #51
solar
Собеседник
 
Аватар для solar
 
Регистрация: 02.02.2009
Сообщения: 61
solar репутация выше +10
По умолчанию

Добрый всем день.
У меня все расчеты происходят в ACCESS. Эфемериды - таблицы, данные -экспортированы из ZET-а. Долгота, широта и пр. интерполируются в VBA. Закавыка в вычислении асцендента и МС. Пока не разобрался с алгоритмом ТОЧНОГО расчета. Было бы здорово если найти ссылку на это дело или мастера бы подсказали :)
solar вне форума   Ответить с цитированием
Старый 13.02.2009, 02:26   #52
LordWilex
В отпуске
 
Аватар для LordWilex
 
Регистрация: 01.06.2008
Адрес: Таганрог
Сообщения: 28,983
LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250
По умолчанию

Цитата:
Сообщение от Алексей
Увидел, что идет повторный вызов функции CHouse с теми же аргументами при заполнении массива csph.

Может быть эту строку можно упростить и привести к такому виду:

csph(i) = StartPoint(cspx(1),cspx(i))

Да конечно можно! :), я это как-то упустил, спасибо, что обратили внимание )))

Цитата:
Сообщение от solar
Добрый всем день.
У меня все расчеты происходят в 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
LordWilex вне форума   Ответить с цитированием
Старый 16.02.2009, 23:14   #53
solar
Собеседник
 
Аватар для solar
 
Регистрация: 02.02.2009
Сообщения: 61
solar репутация выше +10
По умолчанию

Спасибо. Уже изучаю первоисточник. Классная вещь.
____
У Вас в программах кое где не объявляются явно внутренние переменные. Это значит (раз ошибок компилятор не выдает) не задан параметр "Option explicit" в заголовке модуля. Советую задать, чтобы не налететь на случайную ошибку.
solar вне форума   Ответить с цитированием
Старый 16.02.2009, 23:53   #54
LordWilex
В отпуске
 
Аватар для LordWilex
 
Регистрация: 01.06.2008
Адрес: Таганрог
Сообщения: 28,983
LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250
По умолчанию

Цитата:
Сообщение от solar
Спасибо. Уже изучаю первоисточник. Классная вещь.

Приятно слышать ))
Я так понимаю, вы подключили таки ШЭ к ACCESS ?
Если да, не могли бы воложить примерчик, а то я к ACCESS ни когда это дело не пытался подключить, интересно как оно работает в действии.

Цитата:
Сообщение от solar
У Вас в программах кое где не объявляются явно внутренние переменные. Это значит (раз ошибок компилятор не выдает) не задан параметр "Option explicit" в заголовке модуля. Советую задать, чтобы не налететь на случайную ошибку.

Спасибо за совет, учтем в следующей версии!
LordWilex вне форума   Ответить с цитированием
Старый 17.02.2009, 02:06   #55
solar
Собеседник
 
Аватар для solar
 
Регистрация: 02.02.2009
Сообщения: 61
solar репутация выше +10
По умолчанию

Вот как раз сейчас тестирую стартовый расчет. И сразу нестыковка с Zet-ом .
Считаю: 17.02.2009 время 3ч 44 мин.
Широта 59.9 Долгота 30.2 (double)

Результат: Moon = 1 33 39 Стрелец
Solar= 28 37 32 Водолей

В 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.
solar вне форума   Ответить с цитированием
Старый 17.02.2009, 05:37   #56
LordWilex
В отпуске
 
Аватар для LordWilex
 
Регистрация: 01.06.2008
Адрес: Таганрог
Сообщения: 28,983
LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250
По умолчанию

Цитата:
Сообщение от solar
Добавка: видимо дело в разнице во времени +03 ч. для питера
Только непонятно почему ? Выставляю на питер и там и там. Получается что прога считает только в гринвиче.

Тогда расхождение маленькое: Solar - 22 секунды дуги.
Moon - 14 минут дуги.

Да эта штука пока считает только по гринвичу, не доходят руки сделать функцию по переводу в местное время...

Да оно и удобней сразу вбить данные по гринвичу, и не париться.



Нет расхождений даже в 22 секунды быть не должно...

Может быть у вас или в зет или в макросе все-таки подключены эфемериды мойшера?
Дело в том, что когда в коде какой-то сбой автоматом считается именно по ним...

я бы вам еще посоветовал поиграться со строкой:

iflag = SEFLG_TOPOCTR + SEFLG_TRUEPOS + SEFLG_SWIEPH + IIf(isGeo, 0, SEFLG_HELCTR)

На пример у меня она выглядет так:
If CType = "STrop" Then iflag = SEFLG_TRUEPOS + SEFLG_SWIEPH

В а ZET может задаваться через другие флаги, там вариантов многно..

Лучше потестить на сайте ШЭ ( http://astro.com ) там есть такая штука или через jpl'евский горизонс: telnet://horizons.jpl.nasa.gov:6775

В общем, сейчас я наверое иду спать, днем все подробней обмозгую...

Последний раз редактировалось LordWilex, 17.02.2009 в 05:51.
LordWilex вне форума   Ответить с цитированием
Старый 18.02.2009, 00:54   #57
solar
Собеседник
 
Аватар для solar
 
Регистрация: 02.02.2009
Сообщения: 61
solar репутация выше +10
По умолчанию

Все в порядке. Ошибку вывзвала просьба о топоцентр. смещении. Убрал и ошибка по Solar - 1 секунда. По Moon - 9 секунд. Идеал.
solar вне форума   Ответить с цитированием
Старый 18.02.2009, 03:16   #58
LordWilex
В отпуске
 
Аватар для LordWilex
 
Регистрация: 01.06.2008
Адрес: Таганрог
Сообщения: 28,983
LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250LordWilex репутация выше +250
По умолчанию

Ну если у вас задача не связанно со статистикой, то в принципе нормально, работать можно!

А вот в статистике и 2 секунды ошибки иногда много решают...

Все таки у меня подозрения, что у вас почему-то идет автоматическое переключение на Мошьеровские эфемериды, именно они дают расхождение с ШЭ и JPL такого порядка...
LordWilex вне форума   Ответить с цитированием
Старый 18.02.2009, 11:17   #59
solar
Собеседник
 
Аватар для solar
 
Регистрация: 02.02.2009
Сообщения: 61
solar репутация выше +10
По умолчанию

Анекдот. Невязка вызвана тем, что я сначала определял дату в Zet, а затем запускал тест. Разница во времени выполнения этих операций и дала крохотное смещение :)
А эфемериды швейц. - проверил.
solar вне форума   Ответить с цитированием
Старый 18.02.2009, 15:56   #60
solar
Собеседник
 
Аватар для solar
 
Регистрация: 02.02.2009
Сообщения: 61
solar репутация выше +10
По умолчанию

А вот Эрида (Eris) не подключается.
Там указан отступ/смещение с которого начинаются астероиды:

Const SE_AST_OFFSET As Integer = 10000

А номер у Eris - 136199 по каталогу -> и получается ошибка
т.к. больше чем Integer.
solar вне форума   Ответить с цитированием
Ответ


Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +1, время: 03:04.


Powered by vBulletin Version 3.5.4
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
© 1995-2019, ARGO