[Pavel_GP]

Здравствуйте.
Собрал для себя программку, но есть проблемы, подскажите плз.:
Вопрос: Результаты вычислений не отображаются в диалоговом окне, окно закрывается после нажатия кнопки "Вычислить", как исправить?
Спасибо.
P.S. После выбора точки, пропадает значение в графе "Введите параллель".

Код:

[Выделить все]

 RAD : dialog {
label = "xxx";
: column {
: edit_box {
label="Ââåäèòå ïàðàëëåëü, xx.xxxxx°:";
key="fgs";
edit_width = 12;}
}
: row {
 : boxed_column {
	  label = "Ïåðâàÿ òî÷êà";

	: button {
	label = "Âûáðàòü òî÷êó";
	key = "P1";
	edit_width = 12;
	fixed_width = true;
	mnemonic = "Â";
	}

	: edit_box {
	key = "eb1";
	label = "&X1:";
        edit_width = 15;
	fixed_width = true;
	       	   }

	: edit_box {
	key = "eb2";
	label = "&Y1:";
        edit_width = 15;
	fixed_width = true;
	       	   }

}
: column {
 : paragraph {
        label = "Ðåçóëüòàò âû÷èñëåíèé";
        children_alignment = centered;
        width = 50;
        : text { key = "ln1"; }
        : text { key = "ln2"; }
      }
   }
 }

: row {
        fixed_height = true;
        alignment = top;
        spacer;
         : button {
          key    = "accept";    
          label  = "Âû÷èñëèòü";   
          is_default = true;
          height = 3;      
        }
 : button {
          key       = "cancel";
          label     = "Çàêðûòü";
          is_cancel = true;       
          height    = 2;
        }
        }

      : column {
        fixed_height = true;
        alignment = bottom;
        : text {  label = "xxx";  alignment=right;}
        spacer;
      }

}//dialog

Прошу прощения рус/яз не отображается...

[trushev]

По клавише "P1" запускать функцию выполняющую вычисления. Результат заносить в поле "ln1" не выходя из окна. Убрать (done_dialog 3).

[Pavel_GP]

Если убрать (done_dialog 3), кнопка выбора точки становится не активна.

[Кулик Алексей aka kpblc]

После закрытия диалога понадобится снова его создавать с уже новыми данными. У Полещука все это расписано

----- добавлено через ~1 мин. -----
Заодно вспомни, что в done_dialog можно (и часто нужно) передавать соответствующие параметры.

[trushev]

Сообщение от Pavel_GP Если убрать (done_dialog 3), кнопка выбора точки становится не активна.

Не углядел (getpoint "\nУкажите точку: "). Для семейства get-функций требуется временное закрытие окна.

Сообщение от Кулик Алексей aka kpblc У Полещука все это расписано

Кроме этого у Кулик Алексей aka kpblc, на autolisp.ru много полезной информации по взаимодействию autolisp с dcl.
На большее пока нет времени. Думаю справитесь.

[Pavel_GP]

Спс. буду разбираться с Полещуком в подлиннике.

----- добавлено через ~5 ч. -----
Спс. Кулик Алексей aka kpblc,

Я в кнопку вычислить выставил значение done_dialog 2, да теперь окно не закрывается, но недодумываю, как результат вставить в область "Результаты вычислений" ... туда сюда не получается, подкинь идейку.

[Pavel_GP]

Я победил!

Код:

[Выделить все]

 ;-------------------Ôóíêöèÿ ïåðåâîäà êîîðäèíàò-------------------
(defun rpk (/ fg ao f_ps e1 e2 sfg2 ko l1_r ll1_g ll1_m l1_g l1_m l1_s
	    mo1 f1_r ff1_g ff1_m f1_g f1_m f1_s)


  (setq dfg (atof (get_tile "fgs")))

  (defun dtr (a) (* pi (/ a 180.)))

  (defun asin (ugol)
    (atan (/ ugol (sqrt (- 1. (expt ugol 2.)))))
  )

  (defun deg (r) (/ (* r 180.) pi))
  (defun minu (d) (* (- d (fix d)) 60.))
  (defun sek (m) (* (- m (fix m)) 60.))

  (setq fg (dtr dfg))
  (setq ao 6378137.)
  (setq f_ps (/ 1. 298.25722356))
  (setq e1 0.0818191909289067)
  (setq e2 (* f_ps (- 2. f_ps)))
  (setq sfg2 (expt (sin fg) 2.))
  (setq	ko (/ (cos
		fg
	      )
	      (expt (- 1. (* e2 sfg2)) 0.5)
	   )
  )

  (defun px (x) (/ x (* ao ko)))

  (setq l1_r (px x1))
  (setq ll1_g (deg l1_r))
  (setq ll1_m (minu ll1_g))
  (setq l1_s (sek ll1_m))
  (setq l1_g (fix ll1_g))
  (setq l1_m (fix ll1_m))
  (setq l1_s (atof (rtos l1_s 2 2)))
  (set_tile "ln2"
	    (strcat "Äîëãîòà: "
		    (vl-princ-to-string l1_g)
		    "°"
		    (vl-princ-to-string l1_m)
		    "'"
		    (vl-princ-to-string l1_s)
		    "”"
	    )
  )
  (setq	mo1 (- (/ pi 2.)
	       (* 2.
		  (atan	(exp (/ (* -1. y1) (* ao ko))
			)
		  )
	       )
	    )
  )
  (setq	f1_r
	 (+ (+ (+ (+ mo1
		     (*	(sin (* 2. mo1))
			(+ (+ (+ (/ (expt e1 2.) 2.)
				 (* 5. (/ (expt e1 4.) 24.))
			      )
			      (/ (expt e1 6.) 12.)
			   )
			   (* 13. (/ (expt e1 8.) 360.))
			)
		     )
		  )			;1
		  (* (sin (* 4. mo1))
		     (+	(+ (* 7. (/ (expt e1 4.) 48.))
			   (* 29. (/ (expt e1 6.) 240.))
			)
			(* 811. (/ (expt e1 8.) 11520.))
		     )
		  )
	       )			;2
	       (* (sin (* 6. mo1))
		  (+ (* 7. (/ (expt e1 6.) 120.))
		     (* 81. (/ (expt e1 8.) 1120.))
		  )
	       )
	    )				;3
	    (* (sin (* 8. mo1))
	       (* 4279. (/ (expt e1 8.) 161280.))
	    )
	 )				;4
  )					;setq
  (setq ff1_g (deg f1_r))
  (setq ff1_m (minu ff1_g))
  (setq f1_s (sek ff1_m))
  (setq f1_g (fix ff1_g))
  (setq f1_m (fix ff1_m))
  (setq f1_s (atof (rtos f1_s 2 2)))

 (set_tile "ln1"
	    (strcat "Øèðîòà: "
		    (vl-princ-to-string f1_g)
		    "°"
		    (vl-princ-to-string f1_m)
		    "'"
		    (vl-princ-to-string f1_s)
		    "”"
	    )
  )
)					;end defun rpk
;---------------------------Îñíîâíàÿ ôóíêöèÿ----------------------
(defun C:RAD1 (/ dcl_id step pt)
  (setq dcl_id (load_dialog "RAD2.dcl"))
  (setq step 2)
  (if (null pt)
    (setq pt (list 0.0 0.0))
  )
   
  (while (>= step 2)
    (if	(null (new_dialog "RAD2" dcl_id))
      (exit)
    )
;--------------Âûâîä ðåëüòàòà èçìåðåíèé-----------------------
    (rpk)
    (action_tile "ln1" "(rpk)")
    (action_tile "ln2" "(rpk)")
;-------------------------------------------------------------    
    (set_tile "xp" (rtos (car pt) 2 5))
    (set_tile "yp" (rtos (cadr pt) 2 5))

    (mode_tile "fgs" 0)
    (mode_tile "fgs" 2)
 
    (action_tile "cancel" "(done_dialog 0)")
    (action_tile
      "accept"
      (strcat
	"(setq x1 (atof (get_tile \"xp\")))"
	"(setq y1 (atof (get_tile \"yp\")))"
	"(setq dfg (atof (get_tile \"fgs\")))"
	"(setq pt (list x1 y1))"
	"(done_dialog 2)"
       )				;strcat
    )					;action_tile


    (setq step (start_dialog))
  (cond
      ((= step 3)
	(setq pt (getpoint "\nÓêàæèòå òî÷êó: ")))
       );cond
      )					;while    
  (unload_dialog dcl_id)

  (princ)
)

Код:

[Выделить все]

 RAD2 : dialog {label = "Íàçâàíèå ïðîãðàììû";
: column {
: text {label = "Ñèñòåìà êîîðäèíàò WGS-84";
}
: edit_box {
label = "Ââåäèòå ïàðàëëåëü, xx.xxxxx°:";
key = "fgs";
edit_width = 15;
 value = "75";
          }//end edit_box
}//end column
 : spacer{height=1;}

 :row {
:column {
 :edit_box{
 label="X:";
 value="0";
 key="xp";
 width = 15;
 }
 :edit_box{
 label="Y:";
 value="0";
 key="yp";
 width = 15;
 }
 }//end column
 :button{
 label="Óêàçàòü <";
 key="mousep";
 height=6;
 fixed_width=true;
  action="(done_dialog 3)";
  }//end button

  
  : paragraph {
        label = "Ðåçóëüòàò âû÷èñëåíèé";
        children_alignment = centered;
        width = 30;
        height = 3; 
        : text { key = "ln1"; }
        : spacer {height=1;}
        : text { key = "ln2"; }
      }//end paragraph
      }//end row


: row {
        fixed_height = true;
        alignment = top;
        spacer;
         : button {
          key    = "accept";    
          label  = "Âû÷èñëèòü";   
          is_default = true;
          height = 3;      
        }
 : button {
          key       = "cancel";
          label     = "Çàêðûòü";
          is_cancel = true;       
          height    = 2;
        }
        }//end row

      : column {
        fixed_height = true;
        alignment = bottom;
        : text {  label = "xxx";  alignment=right;}
        spacer;
      }//end column

}//end dialog

----- добавлено через ~1 ч. -----
Где-то недочет...
Если изменить значение ключа "fgs" (по умолчанию 75), а потом выбрать точку, то значение "fgs" скидывается обратно на 75.

[gomer]

Сообщение от Pavel_GP Где-то недочет...

Чтобы понять где ваши недочеты, хотя бы приведите ваш код в удобоваримый вид

[Pavel_GP]

Сообщение от gomer Чтобы понять где ваши недочеты, хотя бы приведите ваш код в удобоваримый вид

Посмотри плз.

Победы нет, черт...
Функция выбора точки с временным закрытием диалогового окна (взята мною из руководства Полещука), при загрузки диалога она всегда предлагает выбрать точку (команда while). Но для меня требуется чтобы выбор точки был не конечный результат (чтоб программа временно прерывалась), а при нажатии на кнопку "Вычислить" появлялись результаты основной функции. (set_tile "ln1" "ln2").

[trushev]

Сообщение от Pavel_GP Где-то недочет...

Вставить перед циклом (setq dfg "75"),
вставить перед или сразу после (rpk) (set_tille "fgs" dfg).
И не следует засорять память глобальными переменными.

[Pavel_GP]

Сообщение от trushev Вставить перед циклом (setq dfg "75"), вставить перед или сразу после (rpk) (set_tille "fgs" dfg). И не следует засорять память глобальными переменными.

1. М.б. не так выразился, но проблема не в том чтоб 75 всегда появлялась, а в том что 75 нельзя изменить на другое значение (при новом выборе точки значение опять становиться 75 )
2. Поправьте если я неправ, я как раз память очищаю закинув переменные defun (/ ......), или я не так понял.
спс.

[trushev]

Сообщение от Pavel_GP Поправьте если я неправ

У Вас после присвоения переменной dfg значения поля "fgs" происходит временное закрытие окна. Естественно, что после нового открытия, полю присваивается значение по умолчанию.

[Pavel_GP]

Сообщение от trushev У Вас после присвоения переменной dfg значения поля "fgs" происходит временное закрытие окна. Естественно, что после нового открытия, полю присваивается значение по умолчанию.

1. Так это мне, как раз понятно было Что прописать чтоб после временного закрытия значения поля "fgs", сохраняло своё вновь введённое значение, а не откатывалось к значению по умолчанию?
2. После запуска программы в окне результат вычислений сохранены последние результаты, а хотелось бы чтоб было пусто. (см. вложение)
3. После перезагрузки AUTOCad, программа не запускается "Команда: RAD1
; ошибка: неверный тип аргумента: numberp: nil" (сам лисп загружен), приходиться удалить код

Код:

[Выделить все]

 (rpk)
    (action_tile "ln1" "(rpk)")
    (action_tile "ln2" "(rpk)")

, а потом опять его вставить обратно.

спс.

[trushev]

Сообщение от Pavel_GP 1. Так это мне, как раз понятно было Что прописать чтоб после временного закрытия значения поля "fgs", сохраняло своё вновь введённое значение, а не откатывалось к значению по умолчанию?

В дополнение к посту 10.
1. Изменения касаются строк кода 114 - 121
2. Разобраться с переменной dfg. В строке 136 ей присваивается тип STR, а в строке 6 функции rpk переменная переопределяется на тип REAL. Разберитесь с глобальными и локальными переменными.

Сообщение от Pavel_GP 2. После запуска программы в окне результат вычислений сохранены последние результаты, а хотелось бы чтоб было пусто

При самом первом пуске должны быть результаты по умолчанию. Очистку результатов можно производить дополнив действия по клавише УКАЗАТЬ.

Сообщение от Pavel_GP 3. После перезагрузки AUTOCad, программа не запускается "Команда: RAD1

Включите трассировку и определите точку и причину сбоя.

[Pavel_GP]

Всё, что смог изменил, но вопросы так и остались от #13.
1. Прошу загадками для меня не писать. Если можете вставить нужную функцию там где нужно вставьте плз. (большое Вам спасибо)
2. Причина сбоя думаю в том, что при загрузки диалога функция (rpk) не читается, а где именно проблема для меня это долгая дума.

[gomer]

И как по вашему это должно работать?

Сообщение от Pavel_GP (action_tile "ln1" "(rpk)") (action_tile "ln2" "(rpk)")

[Pavel_GP]

Сообщение от gomer И как по вашему это должно работать?

Привет.

Я предполагаю, что при нажатии на кнопку "Вычислить" происходят вычисления по функции (rpk) и результаты заносятся в значения "ln1 ln2".

Есть какие-то замечания по всему коду ещё?

Какой-то баг в функции (rpk), основная функция её не читает. По идее должно быть так

Код:

[Выделить все]

 
; ---------Osnovnaya fun---------
 (rpk)
 (action_tile "(rpk)")
(while (...))
 

, и тогда были бы вычисления, но ошибка: неверный тип аргумента: numberp: nil

[trushev]

Сообщение от Pavel_GP 1. Прошу загадками для меня не писать. Если можете вставить нужную функцию там где нужно вставьте плз. (большое Вам спасибо) 2. Причина сбоя думаю в том, что при загрузки диалога функция (rpk) не читается, а где именно проблема для меня это долгая дума.

Не хочется отнимать победу.

[Pavel_GP]

Сообщение от trushev Не хочется отнимать победу.

=) Да всё правильно.

Грызу дальше...до победы!

[Кулик Алексей aka kpblc]

Добро пожаловать в пошаговую отладку. А заодно и в области видимости

----- добавлено через ~3 мин. -----
Дополнительно: вход в vlide, меню tools - Environment options - General Options. На закладке Diagnostics установить все флажки. Нажать ОК.
Открыть lsp-код и нажать сочетание клавиш Ctrl+Shift+C. Внимательно проанализировать выводимые сообщения.

[gomer]

Сообщение от trushev Не хочется отнимать победу.

Победу в чем?

Сообщение от Pavel_GP По идее должно быть так

У вас не код, а аццкий фарш и перловка в голове. Начните комментировать свой код, побуквенно, а то вы плаваете как будущий инвалид на экзамене...

Сообщение от Pavel_GP (action_tile "(rpk)")

Что это???
Открывайте справку и пишите, что делает каждая функция.
rpk - это русский православный конь или рулет по-корейски? Что такое функция без аргументов? Что возвращают функции? Что происходит при вызове функции?
Дальше диалог. Что происходит при загрузке диалога? Что происходит при закрытии диалога. Что такое плитки? Откуда и когда их заполнять. Что делает каждая плитка? Какие бывают кнопки? Зачем я вставил эту кнопку в диалог? Что происходит когда я нажал кнопку? Что будет, если я случайно нажал [Esc], [Space] или [Enter] при выборе точки?
Ну и наконец, почему я вставляю там где нужно, а он волшебным образом не начинает работать...

[Pavel_GP]

Сообщение от gomer Победу в чем? У вас не код, а аццкий фарш и перловка в голове. Начните комментировать свой код, побуквенно, а то вы плаваете как будущий инвалид на экзамене... Что это??? Открывайте справку и пишите, что делает каждая функция. rpk - это русский православный конь или рулет по-корейски? Что такое функция без аргументов? Что возвращают функции? Что происходит при вызове функции? Дальше диалог. Что происходит при загрузке диалога? Что происходит при закрытии диалога. Что такое плитки? Откуда и когда их заполнять. Что делает каждая плитка? Какие бывают кнопки? Зачем я вставил эту кнопку в диалог? Что происходит когда я нажал кнопку? Что будет, если я случайно нажал [Esc], [Space] или [Enter] при выборе точки? Ну и наконец, почему я вставляю там где нужно, а он волшебным образом не начинает работать...

1. Только спокойствие.
2. Про перловку и инвалида, я не очень понял тебе понятнее., пропустим.
3. Код на столько прост, но от тебя вытекло, что действительно ты профессор, а я ученик. Но если так, то напиши мне ширину покрытия МЛЭ ЕМ3002?
4. rpk ответ ты дал сам, название пользовательской функции - расшифровка не имеет значения. Функция rpk выполняет основной расчет программы с использованием трех переменных dfg_rad, x1, y1. Команды все стандартные, ничего нового.
5. Локальные, глобальные переменные, буду познавать их предназначение.
6. Код прост, запутался, поэтому мой топик тут, пузыриться не нужно. Прошу только по делу. Пример trushev.

[gomer]

Сообщение от Pavel_GP Только спокойствие.

Это был достаточно прагматичный ответ...

Сообщение от Pavel_GP напиши мне ширину покрытия МЛЭ ЕМ3002?

вот этого?

Еще раз прочитай свой пункт 4. В нем ответ почему твоя программа не запускается

[UrikG]

Если ещё актуально
В функции RAD1 не определены переменные x1 и y1
(defun C:RAD1 (/ dcl_id step pt x1 y1)
(setq dcl_id (load_dialog "RAD2.dcl"))
(setq step 2 x1 0.0 y1 0.0).....у меня всё работает.

----- добавлено через ~1 мин. -----
gomer видимо на это и намекал

[Pavel_GP]

Сообщение от UrikG gomer видимо на это и намекал

Для меня намёки, это как аццкий фарш и перловка в голове.
Спс. UrikG (проверю завтра на работе)
gomer серьёзный продуман, ничего против не имею. Для меня Lisp это лишь упрощение некоторых моментов в моей непосредственной работе.

Сообщение от gomer вот этого?

Ответа точного нет. Так и я листаю Полещука или юзаю гугл.

[UrikG]

Ну тогда вот так...

(defun C:RAD1 (/ dcl_id step pt x1 y1 dfg)
(setq dcl_id (load_dialog "RAD2.dcl"))
(setq step 2 x1 0.0 y1 0.0 dfg 75).....
...
;--------------–Результат вычислений-----------------------

(rpk)
(action_tile "fgs" "(progn (setq dfg (atof (get_tile \"fgs\")))(rpk))") ; ПРИ ИЗМЕНЕНИИ ПОЛЯ ЗАПИСЫВАЕМ ЗНАЧЕНИЕ В ПЕРЕМЕННУЮ dfg
(action_tile "ln1" "(rpk)")
(action_tile "ln2" "(rpk)")
;-------------------------------------------------------------


(defun rpk (/ fg ao f_ps e1 e2 sfg2 ko l1_r ll1_g ll1_m l1_g l1_m l1_s mo1 f1_r ff1_g ff1_m f1_g f1_m f1_s)

;(setq dfg (atof (get_tile "fgs"))) - ЭТУ СТРОКУ ЗАКОМЕТИРОВАТЬ ИЛИ УДАЛИТЬ

[Кулик Алексей aka kpblc]

Сообщение от Pavel_GP Спс. UrikG (проверю завтра на работе)

Ясно, мои рекомендации в #20 отправились лесом.

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc Ясно, мои рекомендации в #20 отправились лесом.

Никуда не лесом. Сегодня всё начну, как раз с п.20., еще не дошёл просто.

----- добавлено через ~1 ч. -----

Сообщение от Кулик Алексей aka kpblc Добро пожаловать в пошаговую отладку. А заодно и в области видимости ----- добавлено через ~3 мин. ----- Дополнительно: вход в vlide, меню tools - Environment options - General Options. На закладке Diagnostics установить все флажки. Нажать ОК. Открыть lsp-код и нажать сочетание клавиш Ctrl+Shift+C. Внимательно проанализировать выводимые сообщения.

Доброе утро. Пользуюсь твоим советом, все как написано. Видим. (см. вложение):
1. Что выдаёт первое окно? Это ошибки? При правильной работе оно должно быть пустым?
2. Что выдает второе окно? (Shift+Ctrl+R) (трассировка), Как с ними дальше обращаться? Оно тоже должно быть пустым при правильной работе?
3. По твоей рекомендации изменил немного в коде

Код:

[Выделить все]

 (defun MyFunRAD (/ dtr deg minu sek px)
  (defun dtr (ar) (* pi (/ ar 180.)))
  (defun deg (rr) (/ (* rr 180.) pi))
  (defun minu (dr) (* (- dr (fix dr)) 60.))
  (defun sek (mr) (* (- mr (fix mr)) 60.))
  (defun px (xr) (/ xr (* ao_wgs84 ko_rad)))
  )

4.UrikG спс., до тебя ещё пока не дошёл, работаю с п.20

----- добавлено через ~38 мин. -----
1. Перевел глобальные переменные в локальные:

Код:

[Выделить все]

 rpk (/ x1 y1 dfg_rad fg ao_wgs84 ko_rad f_ps e1 e2 sfg2  l1_r ll1_g ll1_m l1_g l1_m l1_s
	    mo1 f1_r ff1_g ff1_m f1_g f1_m f1_s)

2. Удалил

Код:

[Выделить все]

 (defun px (xr) (/ xr (* ao_wgs84 ko_rad)))

3.Переопределил

Код:

[Выделить все]

 (setq l1_r (/ x1 (* ao_wgs84 ko_rad)))

Работаем дальше.

----- добавлено через ~3 ч. -----
1. Пока Кулик Алексей aka kpblc нет, но жду его возвращения сюда.
2. Работаю с вариантом от UrikG тут по подробнее:
а) Запускается, ошибку не выдает (Спс)
б) Вопрос открытый остаётся, при нажатии на кнопку "Вычислить" значение "fgs" становится по умолчанию, т.е если его изменить, то оно возвращается обратно. (Должно не возвращаться)

[trushev]

Сообщение от Pavel_GP б) Вопрос открытый остаётся, при нажатии на кнопку "Вычислить" значение "fgs" становится по умолчанию, т.е если его изменить, то оно возвращается обратно. (Должно не возвращаться)

Еще раз. Перед закрытием окна (setq dfg (get_tille "fgs")) сохраняем текущее значение поля. При открытии окна функцией (set_tille "fgs" dfg) восстанавливаем сохраненное значение.

[gomer]

Сообщение от Pavel_GP 1 (defun MyFunRAD (/ dtr deg minu sek px) 2 *(defun dtr (ar) (* pi (/ ar 180.))) 3 *(defun deg (rr) (/ (* rr 180.) pi)) 4 *(defun minu (dr) (* (- dr (fix dr)) 60.)) 5 *(defun sek (mr) (* (- mr (fix mr)) 60.)) 6 *(defun px (xr) (/ xr (* ao_wgs84 ko_rad))) 7 *)

мсъе знает толк в извращениях...

Сообщение от Pavel_GP Должно не возвращаться

Программный код не должен работать правильно
Программный код не должен вообще работать
Программный код вообще никому ничего не должен...

Сообщение от Pavel_GP Вопрос открытый остаётся, при нажатии на кнопку "Вычислить" значение "fgs" становится по умолчанию, т.е если его изменить, то оно возвращается обратно.

Конечно возвращается. Ты же сам написал так, чтоб возвращалось, а теперь, ладно меня, сам себя игнорируешь.

----- добавлено через ~3 мин. -----

Сообщение от trushev Перед закрытием окна (setq dfg (get_tille "fgs")) сохраняем текущее значение поля. При открытии окна функцией (set_tille "fgs" dfg) восстанавливаем сохраненное значение.

Объясни мне зачем закрывать диалог при нажатии кнопки Вычислить?

[Pavel_GP]

Сообщение от gomer Конечно возвращается. Ты же сам написал так, чтоб возвращалось, а теперь, ладно меня, сам себя игнорируешь.

Так поясни где исправить, что ты бегаешь из угла в угол. Что за показуха...

Диалог не закрывается (done_dialog 2).

ПыСы gomer смотри п.20

[trushev]

Сообщение от gomer Объясни мне зачем закрывать диалог при нажатии кнопки Вычислить?

Перед "Вычислить" надо выбрать точку (getpoint "\nУкажите точку: "). Или я неправильно понимаю автора.

[Pavel_GP]

Сообщение от trushev Или я неправильно понимаю автора.

Всё правильно понял.

----- добавлено через ~1 мин. -----

Сообщение от trushev Перед закрытием окна

Ты предполагал о временном закрытии? При нажатии на кнопку Указать, окно закрывается (указывается точка), окно открывается и заносятся координаты точки в х и y.

[trushev]

Уверен восстановление "fgs" по умолчанию происходит после указания точки.

[gomer]

Сообщение от Pavel_GP Диалог не закрывается (done_dialog 2).

Сам-то понял что написал?

Сообщение от Pavel_GP Так поясни где исправить

У тебя авгиевы конюшни, а не код, половина написана в лиспе, половина в диалоге... Сам разбирайся... Где исправить? Везде! Ни один адекватный программист не заполняет action и value в диалоге...

Беда не в том, что у тебя миллион ошибок, а в том, что ты не хозяин своего кода... Быть хозяином - это знать и отвечать за каждую строчку кода. Тогда тебе и отладка не понадобится. А копипаста - это для студентов.
Это так... чтоб работало...

Код:

[Выделить все]

 

(defun dtr (a) (* pi (/ a 180.)))

(defun asin (ugol)
  (atan (/ ugol (sqrt (- 1. (expt ugol 2.)))))
)

(defun deg (r) (/ (* r 180.) pi))
(defun minu (d) (* (- d (fix d)) 60.))
(defun sek (m) (* (- m (fix m)) 60.))




;;; ---------------------------Основная функция----------------------
(defun C:RAD1 (/ rpk dcl_id step pt dfg_rad x1 y1)

  (defun rpk (/	     fg	    ao	   f_ps	  e1	 e2	sfg2   ko
	      l1_r   ll1_g  ll1_m  l1_g	  l1_m	 l1_s	mo1    f1_r
	      ff1_g  ff1_m  f1_g   f1_m	  f1_s
	     )

    (setq fg   (dtr dfg_rad)
	  ao   6378137.
	  f_ps (/ 1. 298.25722356)
	  e1   0.0818191909289067
    )

    (setq e2 (* f_ps (- 2. f_ps)))
    (setq sfg2 (expt (sin fg) 2.))

    (setq ko (/	(cos
		  fg
		)
		(expt (- 1. (* e2 sfg2)) 0.5)
	     )
    )


    (defun px (x) (/ x (* ao ko)))

    (setq l1_r (px x1))

    (setq ll1_g (deg l1_r))
    (setq ll1_m (minu ll1_g))
    (setq l1_s (sek ll1_m))
    (setq l1_g (fix ll1_g))
    (setq l1_m (fix ll1_m))

    (if	(< l1_m 10)
      (setq l1_m (strcat "0" (itoa (fix ll1_m))))
    )
    (if	(< l1_s 10)
      (setq l1_s (strcat "0" (rtos l1_s 2 2)))
      (setq l1_s (atof (rtos l1_s 2 2)))
    )
    (set_tile "ln2"
	      (strcat "Долгота: "
		      (vl-princ-to-string l1_g)
		      "°"
		      (vl-princ-to-string l1_m)
		      "'"
		      (vl-princ-to-string l1_s)
		      "” E"
	      )
    )
    (setq mo1 (- (/ pi 2.)
		 (* 2.
		    (atan (exp (/ (* -1. y1) (* ao ko))
			  )
		    )
		 )
	      )
    )
    (setq f1_r
	   (+ (+ (+ (+ mo1
		       (* (sin (* 2. mo1))
			  (+ (+	(+ (/ (expt e1 2.) 2.)
				   (* 5. (/ (expt e1 4.) 24.))
				)
				(/ (expt e1 6.) 12.)
			     )
			     (* 13. (/ (expt e1 8.) 360.))
			  )
		       )
		    )			;1
		    (* (sin (* 4. mo1))
		       (+ (+ (* 7. (/ (expt e1 4.) 48.))
			     (* 29. (/ (expt e1 6.) 240.))
			  )
			  (* 811. (/ (expt e1 8.) 11520.))
		       )
		    )
		 )			;2
		 (* (sin (* 6. mo1))
		    (+ (* 7. (/ (expt e1 6.) 120.))
		       (* 81. (/ (expt e1 8.) 1120.))
		    )
		 )
	      )				;3
	      (* (sin (* 8. mo1))
		 (* 4279. (/ (expt e1 8.) 161280.))
	      )
	   )				;4
    )					;setq

    (setq ff1_g (deg f1_r))
    (setq ff1_m (minu ff1_g))
    (setq f1_s (sek ff1_m))
    (setq f1_g (fix ff1_g))
    (setq f1_m (fix ff1_m))

    (if	(< f1_m 10)
      (setq f1_m (strcat "0" (itoa (fix ff1_m))))
    )

    (if	(< f1_s 10)
      (setq f1_s (strcat "0" (rtos f1_s 2 2)))
      (setq f1_s (atof (rtos f1_s 2 2)))
    )					;if

    (set_tile "ln1"
	      (strcat "  Широта:  "
		      (vl-princ-to-string f1_g)
		      "°"
		      (vl-princ-to-string f1_m)
		      "'"
		      (vl-princ-to-string f1_s)
		      "” N"
	      )
    )
  ) ;_ end defun rpk

  (setq dcl_id (load_dialog "RAD2.dcl"))

  (setq	step 2
	x1 0.0
	y1 0.0
	dfg_rad	75
  )


  (while (> step 1)

    (if	(null (new_dialog "RAD2" dcl_id))
      (exit)
    )

    (set_tile "fgs_rad" (rtos dfg_rad))
    (set_tile "xp" (rtos x1 2 5))
    (set_tile "yp" (rtos y1 2 5))

    (action_tile "сancel" "(done_dialog 0)")
    (action_tile
      "mousep"
      (strcat
	"(setq dfg_rad (atof (get_tile \"fgs_rad\")))"
	"(done_dialog 2)"
      )					;strcat
    )					;action_tile
    (action_tile
      "calc"
      (strcat
	"(setq dfg_rad (atof (get_tile \"fgs_rad\")))"
	"(setq x1 (atof (get_tile \"xp\")))"
	"(setq y1 (atof (get_tile \"yp\")))"
	"(rpk)"
      )					;strcat
    )					;action_tile

    (setq step (start_dialog))
    (cond
      ((= step 2)
       (setq pt (getpoint "\nУкажите точку: "))
       (if pt
	 (setq x1 (car pt)
	       y1 (cadr pt)
	 )
       )
      )
    )					;cond
  )					;while
  (unload_dialog dcl_id)
  (princ)
)

Код:

[Выделить все]

RAD2 : dialog {

  label = "Название программы";

  : column {

    : text { label = "Система координат WGS-84"; }
 
    : edit_box {
        label = "Введите параллель, xx.xxxxx°:";
        key = "fgs_rad";
        edit_width = 9;
        edit_limit = 8;
    }

  }
  : spacer{height=1;}

  : row {
    : column {
      : edit_box{
        label="X:";
        value="0";
        key="xp";
        width = 15;
      }
      : edit_box{
        label="Y:";
        value="0";
        key="yp";
        width = 15;
      }
    }
    : button {
        label="< Указать";
        key="mousep";
        height=4;
    }
    : button {
          key    = "calc";    
          label  = "Вычислить >";   
          height = 4;
    }


  }//end row
      : paragraph {
        label = "Результат вычислений";
        children_alignment = centered;
        width = 30;
        height = 2; 
        : text { key = "ln1"; }
        : spacer {height=1;}
        : text { key = "ln2"; }
    }//end paragraph
  : row {
        fixed_height = true;
        alignment = top;
        spacer;
        : cancel_button {
          label     = "Закрыть";
          is_cancel = true;       
          height    = 2;
        }
  }//end row

  : column {
        fixed_height = true;
        alignment = bottom;
        : text { label = "xxx";  alignment=right;}
        spacer;
  }//end column

}//end dialog

[Кулик Алексей aka kpblc]

Практически те же фаберже, но вид сбоку

Код:

[Выделить все]

 (defun c:rad1 (/ dcl_id step pt ao ko x1 y1 dtr asin deg minu sek px)
  (defun dtr (a)
    (* pi (/ a 180.))
    ) ;_ end of defun
  (defun asin (ugol)
    (atan (/ ugol (sqrt (- 1. (expt ugol 2.)))))
    ) ;_ end of defun
  (defun deg (r)
    (/ (* r 180.) pi)
    ) ;_ end of defun
  (defun minu (d)
    (* (- d (fix d)) 60.)
    ) ;_ end of defun
  (defun sek (m)
    (* (- m (fix m)) 60.)
    ) ;_ end of defun
  (defun px (x)
    (/ (cond (x)
             (t 0.)
             ) ;_ end of cond
       (* ao ko)
       ) ;_ end of /
    ) ;_ end of defun
  (defun rpk (/ dfg_rad fg ao f_ps e1 e2 sfg2 ko l1_r ll1_g ll1_m l1_g l1_m l1_s mo1 f1_r ff1_g ff1_m f1_g f1_m f1_s)
    (setq dfg_rad (atof (get_tile "fgs_rad"))
          fg      (dtr dfg_rad)
          ao      6378137.
          f_ps    (/ 1. 298.25722356)
          e1      0.0818191909289067
          e2      (* f_ps (- 2. f_ps))
          sfg2    (expt (sin fg) 2.)
          ko      (/ (cos
                       fg
                       ) ;_ end of cos
                     (expt (- 1. (* e2 sfg2)) 0.5)
                     ) ;_ end of /
          l1_r    (px x1)
          ll1_g   (deg l1_r)
          ll1_m   (minu ll1_g)
          l1_s    (sek ll1_m)
          l1_g    (fix ll1_g)
          l1_m    (fix ll1_m)
          ) ;_ end of setq
    (if (< l1_m 10)
      (setq l1_m (strcat "0" (itoa (fix ll1_m))))
      ) ;_ end of if
    (if (< l1_s 10)
      (setq l1_s (strcat "0" (rtos l1_s 2 2)))
      (setq l1_s (atof (rtos l1_s 2 2)))
      ) ;_ end of if
    (set_tile "ln2"
              (strcat "Долгота: "
                      (vl-princ-to-string l1_g)
                      "°"
                      (vl-princ-to-string l1_m)
                      "'"
                      (vl-princ-to-string l1_s)
                      "” E"
                      ) ;_ end of strcat
              ) ;_ end of set_tile
    (setq mo1  (- (/ pi 2.)
                  (* 2.
                     (atan (exp (/ (* -1.
                                      (cond (y1)
                                            (t (setq y1 0.))
                                            ) ;_ end of cond
                                      ) ;_ end of *
                                   (* ao ko)
                                   ) ;_ end of /
                                ) ;_ end of exp
                           ) ;_ end of atan
                     ) ;_ end of *
                  ) ;_ end of -
          f1_r (+ (+ (+ (+ mo1
                           (* (sin (* 2. mo1))
                              (+ (+ (+ (/ (expt e1 2.) 2.)
                                       (* 5. (/ (expt e1 4.) 24.))
                                       ) ;_ end of +
                                    (/ (expt e1 6.) 12.)
                                    ) ;_ end of +
                                 (* 13. (/ (expt e1 8.) 360.))
                                 ) ;_ end of +
                              ) ;_ end of *
                           ) ;1
                        (* (sin (* 4. mo1))
                           (+ (+ (* 7. (/ (expt e1 4.) 48.))
                                 (* 29. (/ (expt e1 6.) 240.))
                                 ) ;_ end of +
                              (* 811. (/ (expt e1 8.) 11520.))
                              ) ;_ end of +
                           ) ;_ end of *
                        ) ;2
                     (* (sin (* 6. mo1))
                        (+ (* 7. (/ (expt e1 6.) 120.))
                           (* 81. (/ (expt e1 8.) 1120.))
                           ) ;_ end of +
                        ) ;_ end of *
                     ) ;3
                  (* (sin (* 8. mo1))
                     (* 4279. (/ (expt e1 8.) 161280.))
                     ) ;_ end of *
                  ) ;4
          ) ;setq
    (setq ff1_g (deg f1_r)
          ff1_m (minu ff1_g)
          f1_s  (sek ff1_m)
          f1_g  (fix ff1_g)
          f1_m  (fix ff1_m)
          ) ;_ end of setq
    (if (< f1_m 10)
      (setq f1_m (strcat "0" (itoa (fix ff1_m))))
      ) ;_ end of if
    (if (< f1_s 10)
      (setq f1_s (strcat "0" (rtos f1_s 2 2)))
      (setq f1_s (atof (rtos f1_s 2 2)))
      )   ;if
    (set_tile "ln1"
              (strcat "  Широта:  "
                      (vl-princ-to-string f1_g)
                      "°"
                      (vl-princ-to-string f1_m)
                      "'"
                      (vl-princ-to-string f1_s)
                      "” N"
                      ) ;_ end of strcat
              ) ;_ end of set_tile
    (gc)
    (princ)
    ) ;_ end of defun

  (setq dcl_id
         (load_dialog
           ((lambda (/ file handle)
              (setq file   (strcat (vl-string-right-trim "\\" (getenv "temp")) "\\dlg.dcl")
                    handle (open file "w")
                    ) ;_ end of setq
              (foreach item
                       '("RAD2:dialog{label=\"Название программы\";"
                         "	:column{"
                         "		:text{label=\"Система координат WGS-84\";}"
                         "		:edit_box{label=\"Введите параллель, xx.xxxxx°:\";key=\"fgs_rad\";edit_width=15;value=\"75\";}"
                         "		}"
                         "	:spacer{height=1;}"
                         "	:row{"
                         "		:column{"
                         "			:edit_box{label=\"X:\";value=\"0\";key=\"xp\";width=15;}"
                         "			:edit_box{label=\"Y:\";value=\"0\";key=\"yp\";width=15;}"
                         "			}"
                         "		:button{label=\"Указать <\";key=\"mousep\";height=6;fixed_width=true;action=\"(done_dialog 3)\";}"
                         "		:paragraph{label=\"Результат вычислений\";children_alignment=centered;width=30;height=2;"
                         "			:text{key=\"ln1\";}"
                         "			:spacer{height=1;}"
                         "			:text{ key=\"ln2\";}"
                         "			}"
                         "		}"
                         "	:row{fixed_height=true;alignment=top;spacer;"
                         "		:button{key =\"accept\";label =\"Вычислить\";is_default=true;height=3;}"
                         "		:button{ key =\"cancel\";label =\"Закрыть\";is_cancel=true;height =2;}"
                         "		}"
                         "	:column{fixed_height=true;alignment=bottom;"
                         "		:text{label=\"xxx\";alignment=right;}"
                         "		spacer;"
                         "		}"
                         "	}"
                         )
                (write-line item handle)
                ) ;_ end of foreach
              (close handle)
              file
              ) ;_ end of lambda
            )
           ) ;_ end of load_dialog
        ) ;_ end of setq
  (setq step 2)
  (if (null pt)
    (setq pt (list 0.0 0.0))
    ) ;_ end of if
  (while (>= step 2)
    (if (null (new_dialog "RAD2" dcl_id))
      (exit)
      ) ;_ end of if
    (rpk)
    (action_tile "ln1" "(rpk)")
    (action_tile "ln2" "(rpk)")
    (set_tile "xp" (rtos (car pt) 2 5))
    (set_tile "yp" (rtos (cadr pt) 2 5))
    (action_tile "сancel" "(done_dialog 0)")
    (action_tile
      "accept"
      (strcat
        "(setq x1 (atof (get_tile \"xp\")))"
        "(setq y1 (atof (get_tile \"yp\")))"
        "(setq pt (list x1 y1))"
        "(done_dialog 2)"
        ) ;strcat
      )   ;action_tile
    (setq step (start_dialog))
    (cond
      ((= step 3)
       (setq pt (getpoint "\nУкажите точку: "))
       )
      )   ;cond
    )     ;while
  (unload_dialog dcl_id)
  (if (< 0 step)
    (progn
      (princ)
      ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

[gomer]

Сообщение от Кулик Алексей aka kpblc Практически те же фаберже, но вид сбоку

kpblc, ну ты то...

[Кулик Алексей aka kpblc]

А мне лениво разбираться в этом спагетти. Сделал, чтобы работало хоть как-то - и пущщай этот Франкенштейн идет дальше Про отладку сказали, про проверки сказали, про видимость сказали, про комментирование и разбор кода в пошаговом режиме сказали - и ладушки

[Pavel_GP]

Сообщение от gomer Беда не в том, что у тебя миллион ошибок, а в том, что ты не хозяин своего кода...

Это не беда не сравнивай свой уровень работы с Lisps и мой, на мой вопрос ты так и не дал ответа, потому что я хозяин в своём деле, а ты в своём.

Сообщение от gomer адекватный программист не заполняет action и value в диалоге...

Читай Полещука

Сообщение от gomer Сам разбирайся... Где исправить? Везде!

У тебя лично помощи не попрашу. Если ты помнишь мы с тобой уже общались на тему внутренних вычислений, там ты мне помог без проблем. Если захочешь сам найдешь эту тему.

1. Это не копипаст. Основные расчёты - это моё, и написано мною, и ошибки тоже мои. Временный выход из диалогового окна взят из "Руководтство по автолиспу Полещук", там у него как раз есть пример. Поэтому не нужно говорить того чего не знаешь...
2. gomer Большое тебе спасибо, наконец-то получился ответ на п.35, но я не просил переписывать мой код, а особенно заменять внутри на свои переменные, чтоб я совсем запутался, а ты потом кричал что у меня авгиевы. конюшни. На счёт его работы - проверю ппж.
3. Кулик Алексей aka kpblc тебе тоже большое спасибо, хоть мои переменные не изменял.
4. Вопрос обоим продуманом gomer и Кулик Алексей aka kpblc, вот нафига из такого простого уравнения вы лепите такие сложности (допфункции, диалоговые окна внутри лиспа и т.д. и т.п.), проще работать не будет? Это конечно всё круто, есть куда стремиться, но мне это не нужно у меня всё просто. 2+2=4, а у вас тоже 4, но через десятки уравнений.
5. Проверю ваши предложения в понедельник, дома не работаю.
Хороших выходных

[gomer]

Сообщение от Pavel_GP я не просил переписывать мой код, а особенно заменять внутри на свои переменные

Я что-то пропустил?

[Кулик Алексей aka kpblc]

Сообщение от Pavel_GP вот нафига из такого простого уравнения вы лепите такие сложности

Ну, я бы не сказал, что "уравнение простое" - может, я просто не стал особо сильно вникать. А те "сложности", что были добавлены, лично для меня преследуют прежде всего одну цель: структурировать код. Хоть немного. В "САПР на базе..." этому подходу очень много посвящено - больше половины книги, если не ошибаюсь.

[gomer]

Сообщение от Кулик Алексей aka kpblc те "сложности", что были добавлены, лично для меня преследуют прежде всего одну цель: структурировать код. Хоть немного.

Тут я с Pavel_GP согласен. Это первая светлая мысль из его головы... kpblc, признайся, что с халтурил, просто перенес диалог в лисп, а все болячки кода так и остались. А раз так, то какой смысл в этом?

[Кулик Алексей aka kpblc]

Почти все - но я поставил доп.обработки nil-значений при вычислениях. Чтобы убрать все болячки, код надо переписывать чуть больше, чем целиком. Я думаю, что пусть лучше автор сам этим займется (да и после твоего кода пытаться что-то сделать - бесперспективняк полнейший )

[Pavel_GP]

Всем привет.
1. gomer. проверил твою работу, всё отлично - как всегда ты любишь краткость и компактность. Есть вопрос: В примере руководства от Полещука (стр. 289), где описывается временный выход из ДО, а именно использована функция done_dialog с аргументом 3, который автоматически становиться возвращаемым значением функции start_dialog. Ты проделал работу по своему усмотрению. Значит временный выход можно достичь разными способами?
2. aka kpblc, твоя обработка работает в старом режиме, при выборе новой точки, слетает значение "fgs".

Всем принимавшим участие, внесенный свой вклад в развитие мне нужной программки Огромное спасибо!!!

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

Планы:
1. Добавить выбор двух точек и их результаты перевода.
2. Добавить формулы расчетов Азимута и Расстояния и выводы их результатов.

[trushev]

Сообщение от Pavel_GP Значит временный выход можно достичь разными способами?

Прошу прощения, что лезу вперед батьки. Если мне не изменяет память для done_dialog зарезервировано три значения -1 - аварийное закрытие окна, 0 - по Esc, 1 - по Enter.

Предлагаю повысить дуракоустойчивость кода дополнив на 151 строке (action_tile "fgs_rad" "(kont $value $key 0 'nil 't)")
где kont

Код:

[Выделить все]

;
;ФУНКЦИЯ КОНТРОЛЯ ВВОДИМЫХ ЦИФРОВЫХ ДАННЫХ
;
(defun kont (val ;значение поля
             key ;ключ поля или 'nil
             n   ;алгебраическое значение минимального числа
             s   ;допускаемое сочетание строковых символов или
                 ;nil - только числа
             p   ;0 - блокирует сообщение alert
                 ;    иное значение можно использовать для других целей
            )
        (if (= (type val) 'STR)
            (if (>= (distof val 1) n)
                val
               ;ИНАЧЕ
                (if (and s
                         (= val s)
                    )
                    val
                   ;ИНАЧЕ
                    (progn
                    (if key
                        (progn
                     ;выделение поля edit_box
                        (mode_tile key 2)
                        (mode_tile key 3)
                        );progn
                    );if key
                    (if (distof val 1)
                        (setq s (strcat "\nВведенное число должно быть больше " (rtos n 2 2)))
                                 ;
                                 ;ИНАЧЕ
                                 ;
                        (if s
                            (setq s (strcat "\nРазрешен ввод только символа \"" s "\"."))
                                 ;
                                 ;ИНАЧЕ
                                 ;
                            (setq s (strcat "\nРазрешен ввод только чисел"
                                            "\nцелая и дробная части которых разделяются символом \".\" (точка)."
                                    )
                            )
                        );if s
                    );if
                    (if (/= p 0)
                        (alert (strcat "                       ОШИБКА ВВОДА!"
                                       "\n" s "."
                               ) 
                        )
                    );if (/= p 0)
                    'nil
                    );progn
                );if (= val s)
            );if
               ;
               ;ИНАЧЕ не предусмотренный вход 
               ;
            (progn
            (alert "Обращение к функции не предусмотрено! СПРАВКА")
            (/ 1.0 0.0)
            );progn
        );if (= (type val) 'STR)
           ;
           ;НА ВЫХОДЕ: 
           ;       val - значение контролируемого параметра
           ;      'nil - обнаружена ошибка
);defun kont

Прошу строго не судить за неоптимальность кода. Основной род моей деятельности как иPavel_GP, в иной сфере.

[Pavel_GP]

Сообщение от trushev done_dialog зарезервировано три значения -1 - аварийное закрытие окна, 0 - по Esc, 1 - по Enter.

Всё правильно глаголишь. Истина. Забыл уточнить, что перед выбором точки переменная step получила значение 3, поэтому может быть любое положительное значение кроме тех которые ты упомянул выше.

----- добавлено через ~3 мин. -----

Сообщение от gomer Цитата: Сообщение от Pavel_GP Посмотреть сообщение Диалог не закрывается (done_dialog 2). Сам-то понял что написал?

Теперь согласен стормозил

trushev напиши для чего нужна твоя функция?, применение ее к моей программе. спс.

----- добавлено через ~2 ч. -----
# Откорректировал формулы перевода, можно работать в разных полушариях. За основу брал обработку от qomer. Да теперь выбор двух точек.

Код:

[Выделить все]

 
(defun dtr (a) (* pi (/ a 180.)))
(defun deg (r) (/ (* r 180.) pi))
(defun minu (d) (* (- d (fix d)) 60.))
(defun sek (m) (* (- m (fix m)) 60.))

;;; ---------------------------Основная функция----------------------
(defun C:RAD (/ rpk dcl_id step pt1 pt2 dfg_rad x1 y1 x2 y2)

  (defun rpk (/	     fg	    ao	   f_ps	  e1	 e2	sfg2   ko
	      l1_r   ll1_go ll1_g  ll1_m  l1_g	 l1_m	l1_s   ew
	      mo1    f1_r   ff1_g  ff1_m  f1_g	 f1_m	f1_s   ns
	      l2_r   ll2_go ll2_g  ll2_m  l2_g	 l2_m	l2_s   mo2
	      f2_r   ff2_g  ff2_m  f2_g	  f2_m	 f2_s
	     )

    (setq fg   (dtr dfg_rad)
	  ao   6378137.
	  f_ps (/ 1. 298.25722356)
	  e1   0.0818191909289067
    )

    (setq e2 (* f_ps (- 2. f_ps)))
    (setq sfg2 (expt (sin fg) 2.))

    (setq ko (/	(cos
		  fg
		)
		(expt (- 1. (* e2 sfg2)) 0.5)
	     )
    )

    (defun px (x) (/ x (* ao ko)))
;;; ----------------------------Первая точка----------------------------
    (setq l1_r (abs (px x1)))
    (setq ll1_go (deg l1_r))
    (setq ll1_g (deg l1_r))
    (if	(> ll1_g 180)
      (setq ll1_g (- 180. (- ll1_g 180.)))
    )
    (setq ll1_m (minu ll1_g))
    (setq l1_g (fix ll1_g))
    (setq l1_m (fix ll1_m))
    (if	(< l1_m 10)
      (setq l1_m (strcat "0" (itoa (fix ll1_m))))
    )
    (setq l1_s (sek ll1_m))
    (if	(= (atof (rtos l1_s 2 2)) 60)
      (progn
	(setq l1_m (strcat "0" (itoa 1)))
	(setq l1_s (strcat "0" (rtos 0. 2 2)))
      )
      (progn
	(if (< l1_s 10)
	  (progn
	    (setq l1_s (strcat "0" (rtos l1_s 2 2)))
	  )
	  (progn
	    (setq l1_s (atof (rtos l1_s 2 2)))
	  )
	)				;if
      )
    )					;if
    (if	(> x1 0)
      (progn
	(if (< ll1_go 180)
	  (progn
	    (setq ew "” E")
	  )
	  (progn
	    (setq ew "” W")
	  )
	)				;if
      )
      (progn
	(if (< ll1_go 180)
	  (progn
	    (setq ew "” W")
	  )
	  (progn
	    (setq ew "” E")
	  )
	)				;if
      )
    )					;if
    (set_tile "ln2"
	      (strcat "Долгота: "
		      (vl-princ-to-string l1_g)
		      "°"
		      (vl-princ-to-string l1_m)
		      "'"
		      (vl-princ-to-string l1_s)
		      ew
	      )
    )
    (setq mo1 (- (/ pi 2.)
		 (* 2.
		    (atan (exp (/ (* -1. y1) (* ao ko))
			  )
		    )
		 )
	      )
    )
    (setq f1_r
	   (+ (+ (+ (+ mo1
		       (* (sin (* 2. mo1))
			  (+ (+	(+ (/ (expt e1 2.) 2.)
				   (* 5. (/ (expt e1 4.) 24.))
				)
				(/ (expt e1 6.) 12.)
			     )
			     (* 13. (/ (expt e1 8.) 360.))
			  )
		       )
		    )			;1
		    (* (sin (* 4. mo1))
		       (+ (+ (* 7. (/ (expt e1 4.) 48.))
			     (* 29. (/ (expt e1 6.) 240.))
			  )
			  (* 811. (/ (expt e1 8.) 11520.))
		       )
		    )
		 )			;2
		 (* (sin (* 6. mo1))
		    (+ (* 7. (/ (expt e1 6.) 120.))
		       (* 81. (/ (expt e1 8.) 1120.))
		    )
		 )
	      )				;3
	      (* (sin (* 8. mo1))
		 (* 4279. (/ (expt e1 8.) 161280.))
	      )
	   )				;4
    )					;setq
    (setq f1_r (abs f1_r))
    (setq ff1_g (deg f1_r))
    (setq ff1_m (minu ff1_g))
    (setq f1_g (fix ff1_g))
    (setq f1_m (fix ff1_m))
    (if	(< f1_m 10)
      (setq f1_m (strcat "0" (itoa (fix ff1_m))))
    )
    (setq f1_s (sek ff1_m))
    (if	(= (atof (rtos f1_s 2 2)) 60)
      (progn
	(setq f1_m (strcat "0" (itoa 1)))
	(setq f1_s (strcat "0" (rtos 0. 2 2)))
      )
      (progn
	(if (< f1_s 10)
	  (progn
	    (setq f1_s (strcat "0" (rtos f1_s 2 2)))
	  )
	  (progn
	    (setq f1_s (atof (rtos f1_s 2 2)))
	  )
	)				;if
      )
    )					;if
    (if	(= ff1_g 90)
      (progn
	(set_tile "ln1"
		  (strcat "  Широта:  "
			  "ПОЛЮС. ПРОВЕРЬ ДАННЫЕ!!!"
		  )
	)
      )
      (progn
	(if (> y1 0)
	  (progn
	    (setq ns "” N")
	  )
	  (progn
	    (setq ns "” S")
	  )
	)				;if
	(set_tile "ln1"
		  (strcat "  Широта:  "
			  (vl-princ-to-string f1_g)
			  "°"
			  (vl-princ-to-string f1_m)
			  "'"
			  (vl-princ-to-string f1_s)
			  ns
		  )
	)
      )
    )					;if
;;; --------------------------end Первая точка----------------------
;;; -------------------------Вторая точка---------------------------
    (setq l2_r (abs (px x2)))
    (setq ll2_go (deg l2_r))
    (setq ll2_g (deg l2_r))
    (if	(> ll2_g 180)
      (setq ll2_g (- 180. (- ll2_g 180.)))
    )
    (setq ll2_m (minu ll2_g))
    (setq l2_g (fix ll2_g))
    (setq l2_m (fix ll2_m))
    (if	(< l2_m 10)
      (setq l2_m (strcat "0" (itoa (fix ll2_m))))
    )
    (setq l2_s (sek ll2_m))
    (if	(= (atof (rtos l2_s 2 2)) 60)
      (progn
	(setq l2_m (strcat "0" (itoa 1)))
	(setq l2_s (strcat "0" (rtos 0. 2 2)))
      )
      (progn
	(if (< l2_s 10)
	  (progn
	    (setq l2_s (strcat "0" (rtos l2_s 2 2)))
	  )
	  (progn
	    (setq l2_s (atof (rtos l2_s 2 2)))
	  )
	)				;if
      )
    )					;if
    (if	(> x2 0)
      (progn
	(if (< ll2_go 180)
	  (progn
	    (setq ew "” E")
	  )
	  (progn
	    (setq ew "” W")
	  )
	)				;if
      )
      (progn
	(if (< ll2_go 180)
	  (progn
	    (setq ew "” W")
	  )
	  (progn
	    (setq ew "” E")
	  )
	)				;if
      )
    )					;if
    (set_tile "ln4"
	      (strcat "Долгота: "
		      (vl-princ-to-string l2_g)
		      "°"
		      (vl-princ-to-string l2_m)
		      "'"
		      (vl-princ-to-string l2_s)
		      ew
	      )
    )
    (setq mo2 (- (/ pi 2.)
		 (* 2.
		    (atan (exp (/ (* -1. y2) (* ao ko))
			  )
		    )
		 )
	      )
    )
    (setq f2_r
	   (+ (+ (+ (+ mo2
		       (* (sin (* 2. mo2))
			  (+ (+	(+ (/ (expt e1 2.) 2.)
				   (* 5. (/ (expt e1 4.) 24.))
				)
				(/ (expt e1 6.) 12.)
			     )
			     (* 13. (/ (expt e1 8.) 360.))
			  )
		       )
		    )			;1
		    (* (sin (* 4. mo2))
		       (+ (+ (* 7. (/ (expt e1 4.) 48.))
			     (* 29. (/ (expt e1 6.) 240.))
			  )
			  (* 811. (/ (expt e1 8.) 11520.))
		       )
		    )
		 )			;2
		 (* (sin (* 6. mo2))
		    (+ (* 7. (/ (expt e1 6.) 120.))
		       (* 81. (/ (expt e1 8.) 1120.))
		    )
		 )
	      )				;3
	      (* (sin (* 8. mo2))
		 (* 4279. (/ (expt e1 8.) 161280.))
	      )
	   )				;4
    )					;setq
    (setq f2_r (abs f2_r))
    (setq ff2_g (deg f2_r))
    (setq ff2_m (minu ff2_g))
    (setq f2_s (sek ff2_m))
    (setq f2_g (fix ff2_g))
    (setq f2_m (fix ff2_m))
    (if	(< f2_m 10)
      (setq f2_m (strcat "0" (itoa (fix ff2_m))))
    )
    (setq f2_s (sek ff2_m))
    (if	(= (atof (rtos f2_s 2 2)) 60)
      (progn
	(setq f2_m (strcat "0" (itoa 1)))
	(setq f2_s (strcat "0" (rtos 0. 2 2)))
      )
      (progn
	(if (< f2_s 10)
	  (progn
	    (setq f2_s (strcat "0" (rtos f2_s 2 2)))
	  )
	  (progn
	    (setq f2_s (atof (rtos f2_s 2 2)))
	  )
	)				;if
      )
    )					;if
    (if	(= ff2_g 90)
      (progn
	(set_tile "ln3"
		  (strcat "  Широта:  "
			  "ПОЛЮС. ПРОВЕРЬ ДАННЫЕ!!!"
		  )
	)
      )
      (progn
	(if (> y2 0)
	  (progn
	    (setq ns "” N")
	  )
	  (progn
	    (setq ns "” S")
	  )
	)				;if
	(set_tile "ln3"
		  (strcat "  Широта:  "
			  (vl-princ-to-string f2_g)
			  "°"
			  (vl-princ-to-string f2_m)
			  "'"
			  (vl-princ-to-string f2_s)
			  ns
		  )
	)
      )
    )					;if
;;; -----------------end Вторая точка----------------
  ) ;_ end defun rpk

  (setq dcl_id (load_dialog "RAD_gomer.dcl"))

  (setq	step 2
	x1 0.0
	y1 0.0
	x2 0.0
	y2 0.0
	dfg_rad	75
  )

  (while (> step 1)

    (if	(null (new_dialog "RAD" dcl_id))
      (exit)
    )

    (set_tile "fgs_rad" (rtos dfg_rad))
    (set_tile "xp1" (rtos x1 2 5))
    (set_tile "yp1" (rtos y1 2 5))
    (set_tile "xp2" (rtos x2 2 5))
    (set_tile "yp2" (rtos y2 2 5))

    (action_tile "сancel" "(done_dialog 0)")
    (action_tile
      "mousep"
      (strcat
	"(setq dfg_rad (atof (get_tile \"fgs_rad\")))"
	"(done_dialog 2)"
      )					;strcat
    )					;action_tile
;;; ------------------Вывод результатов----------------------------
    (action_tile
      "calc"
      (strcat
	"(setq dfg_rad (atof (get_tile \"fgs_rad\")))"
	"(setq x1 (atof (get_tile \"xp1\")))"
	"(setq y1 (atof (get_tile \"yp1\")))"
	"(setq x2 (atof (get_tile \"xp2\")))"
	"(setq y2 (atof (get_tile \"yp2\")))"
	"(rpk)"
       )				;strcat
    )					;action_tile
;;; ---------------------------------------------------------------
    (setq step (start_dialog))
    (cond
      ((= step 2)
       (setq pt1 (getpoint "\nУкажите точку: "))
       (setq pt2 (getpoint "\nУкажите вторую точку: " pt1))
       (if pt1
	 (setq x1 (car pt1)
	       y1 (cadr pt1)
	 )
       )
       (if pt2
	 (setq x2 (car pt2)
	       y2 (cadr pt2)
	 )
       )
      )
    )					;cond
  )					;while
  (unload_dialog dcl_id)
  (princ)
)

Код:

[Выделить все]

 RAD : dialog{
              label = "Название программы";
  : column{
    : text{
              label = "Проекция Меркатора. Система координат WGS-84"; }
 
    : edit_box{
              label = "Введите параллель, xx.xxxxx°:";
              key   = "fgs_rad";
         edit_width = 9;
         edit_limit = 8;
    }

  }
  : spacer{height=1;}

  : row{
  :column{
 //-----------------Первая точка-----------------
:boxed_column{
             label = "Первая точка";
      : edit_box{
             label = "X1:";
             value = "0";
             key   = "xp1";
             width = 15;
      }
      : edit_box{
             label = "Y1:";
             value = "0";
             key   = "yp1";
             width = 15;
      }
    }
//-------------------Вторая точка-----------------
:boxed_column{
            label = "Вторая точка";
      : edit_box{
            label = "X2:";
            value = "0";
            key   = "xp2";
            width = 15;
      }
      : edit_box{
            label = "Y2:";
            value = "0";
            key   = "yp2";
            width = 15;
      }
    }
    }//end column
    :column{
    : button{
           key   = "mousep";
           label = "< Указать";
          height = 4;
    }
    : button{
           key   = "calc";    
           label = "Вычислить >";   
          height = 4;
    }
}//end column

  }//end row
      : paragraph{
           label = "Результат вычислений";
          children_alignment
                 = centered;
           width = 30;
          height = 2; 
        : text{
           key   = "ln1";
          }
        : text{
           key   = "ln2";
          }
          : spacer {height=1;}
        : text{
           key   = "ln3";
          }
        : text{
           key   = "ln4";
          }
    }//end paragraph
  : row{
    fixed_height = true;
       alignment = top;
        spacer;
        : cancel_button{
          label  = "Закрыть";
          is_cancel
                 = true;       
          height = 2;
        }
  }//end row

  : column{
    fixed_height = true;
       alignment = bottom;
       : text{
           label = "Pavel_GP";
       alignment = right;
           }
        spacer;
  }//end column

}//end dialog

[gomer]

Сообщение от trushev Предлагаю повысить дуракоустойчивость кода дополнив на 151 строке (action_tile "fgs_rad" (kont $value $key 'nil 't))

Это абсолютно бесполезная затея. Зачем делать проверку события, если оно может произойти, а может и не произойти? Проверку нужно делать непосредственно перед вычислением, то есть проверка должна быть в функции отклика кнопки "calc". Причем проверять нужно не только это значение, но и координаты.

Вместо

Код:

[Выделить все]

  : column{
    fixed_height = true;
       alignment = bottom;
       : text{
           label = "Pavel_GP";
       alignment = right;
           }
       : text{
           label = "ред. gomer, akka_KPbIC";
       alignment = right;
        }
        spacer;
  }//end column

лучше добавить кнопку "info", которая будет вызывать (alert "Справочная информация\n...")
И вообще я под этой программой не подписывался, мне дорога моя репутация...

[trushev]

gomer, Никоем образом не думал подвергнуть критике Ваш код. Понятно, написан на скорую руку, лишь бы работал. Не настаиваю на своей затее. Согласен что защищать в этом случае нужно и координаты. Либо для координат предусмотреть блокировку полей или вводить их в text_part. согласен "info" не помешает.

----- добавлено через ~5 мин. -----
Pavel_GP, Исправил ошибку в (action_tile "fgs_rad" (kont $value $key 0 'nil 't)).
Функция предназначена для контроля введенных в поле edit_box значений. В случае ввода не цифровых данных или числа более n выводит сообщение об ошибке и подсвечивает поле с ошибкой. При желании может быть дополнена блокировкой клавиши "Вычислить".

[Pavel_GP]

1. trushev Сегодня протестирую, посмотрю, спс за труд.
2. gomer ты опять за своё.. Это ещё не программа, эта бушующая программа специфичная. (чтоб её проверять нужно сначала библиотеку данных настроить в цивиле), чтоб судить о ней работает или нет. Для простого пользователя это будут просто цифры и буквы. Убрал я тебя из окна, всё таки твою огранку кода взял Тебя в моей компании знаю , только я, топик мой, все расчёты мои о какой репутации ты боишься? Просто будь учителем, но не вредным - совет А вообщем большой тебе респект

----- добавлено через ~29 мин. -----
3. trushev запустил твой код.
срабатывает при запуске программы "Обращение к функции не предусмотрено! СПРАВКА" Ошибка: деление на нуль., программа закрывается.

[trushev]

Сообщение от Pavel_GP срабатывает при запуске программы "Обращение к функции не предусмотрено! СПРАВКА" Ошибка: деление на нуль., программа закрывается.

Такое возможно, если тип данных подавемых на вход не STR.
(action_tile "fgs_rad" (kont $value $key 0 'nil 't)) $value - считывает текущее значение поля edit_box и всегда должно быть STR.
Что подается на вход функции ?

[Pavel_GP]

Сообщение от trushev Что подается на вход функции ?

Real, опять голову ломать, кто-то халтурил..., и что мне делать с этой бедой..., только не понять, в edit_box летят строковые значения

[trushev]

Сообщение от Pavel_GP Real, опять голову ломать, кто-то халтурил...

Напиши свою редакцию (action_tile "fgs_rad" (kont $value $key 0 'nil 't))
В крайнем случае попробуй заменить $value на (get_tile \"fgs_rad\")

[Pavel_GP]

Сообщение от trushev Напиши свою редакцию

что написать, ты меня вводишь в тупик

----- добавлено через ~7 мин. -----
Почему ругается непонятно:
После запуска программы в edit_box летят значения

Код:

[Выделить все]

 (set_tile "fgs_rad" (rtos dfg_rad))
    (set_tile "xp1" (rtos x1 2 5))
    (set_tile "yp1" (rtos y1 2 5))
    (set_tile "xp2" (rtos x2 2 5))
    (set_tile "yp2" (rtos y2 2 5))

берущиеся из

Код:

[Выделить все]

 (setq	step 2
	x1 0.0
	y1 0.0
	x2 0.0
	y2 0.0
	dfg_rad	75.0
  )

, так?

[trushev]

Сообщение от Pavel_GP После запуска программы в edit_box летят значения

После запуска программы или функции kont?

Смотри lsp #46
на строке 364 (set_tile "fgs_rad" (rtos dfg_rad)) выполняется присвоение полю текущего значения dfg_rad.
Если на пустую 369 строку вставить (action_tile "fgs_rad" (kont $value $key 0 'nil 't)), то при редактировании поля (вводе другого значения)
будет выполняться контроль корректности введенного значения. При переходе к другому полю (клавише) $value считает введенное
значение поля "fgs_rad", $key считает имя ключа - "fgs_rad", 0 - допускаемое минимальное значение поля "fgs_rad",
'nil - разрешен ввод только цифровых данных, 't - при ошибке сообщение не блокируется.
Если в поле будет введен не цифровой символ, или число менее 0 появится информационное сообщение об
ошибке и подсветится введенное в поле "fgs_rad" ошибочное значение.
Функция должна быть описана в lsp.

[Pavel_GP]

Сообщение от trushev то при редактировании поля

в п.#49 я писал о том, что вылетает ошибка до редактирования, сразу после запуска [с твоей строки (action_tile "fgs_rad" (kont $value $key 0 'nil 't))], смысл работы твоего кода понятен. Но если бы в edit_box подавалось бы не текстовое значение, он бы сразу ругнулся. А у меня подается текст.

[trushev]

Сообщение от Pavel_GP вылетает ошибка до редактирования

Прошу прощения. Забыл про кавычки.
(action_tile "fgs_rad" "(kont $value $key 0 'nil 't)"), исправил в #45

[Pavel_GP]

Спс. всё заработало.
Просьба если не трудно: доделать свой код , а именно внести проверку на точку (.)

Код:

[Выделить все]

 (setq s (strcat "\nРазрешен ввод только чисел"
                   "\nцелая и дробная части которых разделяются символом \".\" (точка)."
           )
  )

в координатах x1 y1 x2 y2, при вводе вручную.
спс.

----- добавлено через ~2 ч. -----
Вставил Расчёт Азимута (в прямом и обратном направлениях)

Код:

[Выделить все]

 (defun dtr (a) (* pi (/ a 180.)))
(defun deg (r) (/ (* r 180.) pi))
(defun minu (d) (* (- d (fix d)) 60.))
(defun sek (m) (* (- m (fix m)) 60.))

;;; ---------------------------Основная функция----------------------
(defun C:RAD (/	rpk kont dcl_id	step pt1 pt2 dfg_rad x1	y1 x2 y2 )

  (defun rpk (/	     fg	    ao	   f_ps	  e1	 e2	sfg2   ko
	      l1_r   ll1_go ll1_g  ll1_m  l1_g	 l1_m	l1_s   ew
	      mo1    f1_r   ff1_g  ff1_m  f1_g	 f1_m	f1_s   ns
	      l2_r   ll2_go ll2_g  ll2_m  l2_g	 l2_m	l2_s   mo2
	      f2_r   ff2_g  ff2_m  f2_g	  f2_m	 f2_s	Az     Az180
	     )

    (setq fg   (dtr dfg_rad)
	  ao   6378137.
	  f_ps (/ 1. 298.25722356)
	  e1   0.0818191909289067
    )

    (setq e2 (* f_ps (- 2. f_ps)))
    (setq sfg2 (expt (sin fg) 2.))

    (setq ko (/	(cos
		  fg
		)
		(expt (- 1. (* e2 sfg2)) 0.5)
	     )
    )

    (defun px (x) (/ x (* ao ko)))
;;; ----------------------------Первая точка----------------------------
    (setq l1_r (abs (px x1)))
    (setq ll1_go (deg l1_r))
    (setq ll1_g (deg l1_r))
    (if	(> ll1_g 180)
      (setq ll1_g (- 180. (- ll1_g 180.)))
    )
    (setq ll1_m (minu ll1_g))
    (setq l1_g (fix ll1_g))
    (setq l1_m (fix ll1_m))
    (if	(< l1_m 10)
      (setq l1_m (strcat "0" (itoa (fix ll1_m))))
    )
    (setq l1_s (sek ll1_m))
    (if	(= (atof (rtos l1_s 2 2)) 60)
      (progn
	(setq l1_m (strcat "0" (itoa 1)))
	(setq l1_s (strcat "0" (rtos 0. 2 2)))
      )
      (progn
	(if (< l1_s 10)
	  (progn
	    (setq l1_s (strcat "0" (rtos l1_s 2 2)))
	  )
	  (progn
	    (setq l1_s (atof (rtos l1_s 2 2)))
	  )
	)				;if
      )
    )					;if
    (if	(> x1 0)
      (progn
	(if (< ll1_go 180)
	  (progn
	    (setq ew "” E")
	  )
	  (progn
	    (setq ew "” W")
	  )
	)				;if
      )
      (progn
	(if (< ll1_go 180)
	  (progn
	    (setq ew "” W")
	  )
	  (progn
	    (setq ew "” E")
	  )
	)				;if
      )
    )					;if
    (set_tile "ln2"
	      (strcat "Долгота: "
		      (vl-princ-to-string l1_g)
		      "°"
		      (vl-princ-to-string l1_m)
		      "'"
		      (vl-princ-to-string l1_s)
		      ew
	      )
    )
    (setq mo1 (- (/ pi 2.)
		 (* 2.
		    (atan (exp (/ (* -1. y1) (* ao ko))
			  )
		    )
		 )
	      )
    )
    (setq f1_r
	   (+ (+ (+ (+ mo1
		       (* (sin (* 2. mo1))
			  (+ (+	(+ (/ (expt e1 2.) 2.)
				   (* 5. (/ (expt e1 4.) 24.))
				)
				(/ (expt e1 6.) 12.)
			     )
			     (* 13. (/ (expt e1 8.) 360.))
			  )
		       )
		    )			;1
		    (* (sin (* 4. mo1))
		       (+ (+ (* 7. (/ (expt e1 4.) 48.))
			     (* 29. (/ (expt e1 6.) 240.))
			  )
			  (* 811. (/ (expt e1 8.) 11520.))
		       )
		    )
		 )			;2
		 (* (sin (* 6. mo1))
		    (+ (* 7. (/ (expt e1 6.) 120.))
		       (* 81. (/ (expt e1 8.) 1120.))
		    )
		 )
	      )				;3
	      (* (sin (* 8. mo1))
		 (* 4279. (/ (expt e1 8.) 161280.))
	      )
	   )				;4
    )					;setq
    (setq f1_r (abs f1_r))
    (setq ff1_g (deg f1_r))
    (setq ff1_m (minu ff1_g))
    (setq f1_g (fix ff1_g))
    (setq f1_m (fix ff1_m))
    (if	(< f1_m 10)
      (setq f1_m (strcat "0" (itoa (fix ff1_m))))
    )
    (setq f1_s (sek ff1_m))
    (if	(= (atof (rtos f1_s 2 2)) 60)
      (progn
	(setq f1_m (strcat "0" (itoa 1)))
	(setq f1_s (strcat "0" (rtos 0. 2 2)))
      )
      (progn
	(if (< f1_s 10)
	  (progn
	    (setq f1_s (strcat "0" (rtos f1_s 2 2)))
	  )
	  (progn
	    (setq f1_s (atof (rtos f1_s 2 2)))
	  )
	)				;if
      )
    )					;if
    (if	(= ff1_g 90)
      (progn
	(set_tile "ln1"
		  (strcat "  Широта:  "
			  "ПОЛЮС. ПРОВЕРЬ ДАННЫЕ!!!"
		  )
	)
      )
      (progn
	(if (> y1 0)
	  (progn
	    (setq ns "” N")
	  )
	  (progn
	    (setq ns "” S")
	  )
	)				;if
	(set_tile "ln1"
		  (strcat "  Широта:  "
			  (vl-princ-to-string f1_g)
			  "°"
			  (vl-princ-to-string f1_m)
			  "'"
			  (vl-princ-to-string f1_s)
			  ns
		  )
	)
      )
    )					;if
;;; --------------------------end Первая точка----------------------
;;; -------------------------Вторая точка---------------------------
    (setq l2_r (abs (px x2)))
    (setq ll2_go (deg l2_r))
    (setq ll2_g (deg l2_r))
    (if	(> ll2_g 180)
      (setq ll2_g (- 180. (- ll2_g 180.)))
    )
    (setq ll2_m (minu ll2_g))
    (setq l2_g (fix ll2_g))
    (setq l2_m (fix ll2_m))
    (if	(< l2_m 10)
      (setq l2_m (strcat "0" (itoa (fix ll2_m))))
    )
    (setq l2_s (sek ll2_m))
    (if	(= (atof (rtos l2_s 2 2)) 60)
      (progn
	(setq l2_m (strcat "0" (itoa 1)))
	(setq l2_s (strcat "0" (rtos 0. 2 2)))
      )
      (progn
	(if (< l2_s 10)
	  (progn
	    (setq l2_s (strcat "0" (rtos l2_s 2 2)))
	  )
	  (progn
	    (setq l2_s (atof (rtos l2_s 2 2)))
	  )
	)				;if
      )
    )					;if
    (if	(> x2 0)
      (progn
	(if (< ll2_go 180)
	  (progn
	    (setq ew "” E")
	  )
	  (progn
	    (setq ew "” W")
	  )
	)				;if
      )
      (progn
	(if (< ll2_go 180)
	  (progn
	    (setq ew "” W")
	  )
	  (progn
	    (setq ew "” E")
	  )
	)				;if
      )
    )					;if
    (set_tile "ln4"
	      (strcat "Долгота: "
		      (vl-princ-to-string l2_g)
		      "°"
		      (vl-princ-to-string l2_m)
		      "'"
		      (vl-princ-to-string l2_s)
		      ew
	      )
    )
    (setq mo2 (- (/ pi 2.)
		 (* 2.
		    (atan (exp (/ (* -1. y2) (* ao ko))
			  )
		    )
		 )
	      )
    )
    (setq f2_r
	   (+ (+ (+ (+ mo2
		       (* (sin (* 2. mo2))
			  (+ (+	(+ (/ (expt e1 2.) 2.)
				   (* 5. (/ (expt e1 4.) 24.))
				)
				(/ (expt e1 6.) 12.)
			     )
			     (* 13. (/ (expt e1 8.) 360.))
			  )
		       )
		    )			;1
		    (* (sin (* 4. mo2))
		       (+ (+ (* 7. (/ (expt e1 4.) 48.))
			     (* 29. (/ (expt e1 6.) 240.))
			  )
			  (* 811. (/ (expt e1 8.) 11520.))
		       )
		    )
		 )			;2
		 (* (sin (* 6. mo2))
		    (+ (* 7. (/ (expt e1 6.) 120.))
		       (* 81. (/ (expt e1 8.) 1120.))
		    )
		 )
	      )				;3
	      (* (sin (* 8. mo2))
		 (* 4279. (/ (expt e1 8.) 161280.))
	      )
	   )				;4
    )					;setq
    (setq f2_r (abs f2_r))
    (setq ff2_g (deg f2_r))
    (setq ff2_m (minu ff2_g))
    (setq f2_s (sek ff2_m))
    (setq f2_g (fix ff2_g))
    (setq f2_m (fix ff2_m))
    (if	(< f2_m 10)
      (setq f2_m (strcat "0" (itoa (fix ff2_m))))
    )
    (setq f2_s (sek ff2_m))
    (if	(= (atof (rtos f2_s 2 2)) 60)
      (progn
	(setq f2_m (strcat "0" (itoa 1)))
	(setq f2_s (strcat "0" (rtos 0. 2 2)))
      )
      (progn
	(if (< f2_s 10)
	  (progn
	    (setq f2_s (strcat "0" (rtos f2_s 2 2)))
	  )
	  (progn
	    (setq f2_s (atof (rtos f2_s 2 2)))
	  )
	)				;if
      )
    )					;if
    (if	(= ff2_g 90)
      (progn
	(set_tile "ln3"
		  (strcat "  Широта:  "
			  "ПОЛЮС. ПРОВЕРЬ ДАННЫЕ!!!"
		  )
	)
      )
      (progn
	(if (> y2 0)
	  (progn
	    (setq ns "” N")
	  )
	  (progn
	    (setq ns "” S")
	  )
	)				;if
	(set_tile "ln3"
		  (strcat "  Широта:  "
			  (vl-princ-to-string f2_g)
			  "°"
			  (vl-princ-to-string f2_m)
			  "'"
			  (vl-princ-to-string f2_s)
			  ns
		  )
	)
      )
    )					;if
;;; -----------------------end Вторая точка--------------------------
;;; ------------------------Расчёт Азимута---------------------------
    (if	(= y2 y1)
      (progn
	(if (= x2 x1)
	  (progn
	    (set_tile "ln5"
		      (strcat "Азимут: "
			      "НЕ ВЕРНЫЕ ДАННЫЕ"
		      )
	    )
	  )
	  (progn
	    (if	(> x2 x1)		;когда 90°
	      (progn
		(setq Az 90.)
		(setq Az180 (+ Az 180.))
		(set_tile "ln5"
			  (strcat "Азимут: "
				  (vl-princ-to-string Az)
				  "°"
				  "-"
				  (vl-princ-to-string Az180)
				  "°    "
			  )
		)
	      )				;> x2 x1
	      (progn			;когда 270°
		(setq Az 270.)
		(setq Az180 (- Az 180.))
		(set_tile "ln5"
			  (strcat "Азимут: "
				  (vl-princ-to-string Az)
				  "°"
				  "-"
				  (vl-princ-to-string Az180)
				  "°    "
			  )
		)
	      )				;< x2 x1
	    )				;if > x2 x1
	  )
	)				;if = x2 x1
      )
      (progn				;/= y2 y1
	(if (= x2 x1)
	  (progn
	    (if	(> y2 y1)
	      (progn			;когда 0°
		(setq Az 0.)
		(setq Az180 (+ Az 180.))
		(set_tile "ln5"
			  (strcat "Азимут: "
				  (vl-princ-to-string Az)
				  "°"
				  "-"
				  (vl-princ-to-string Az180)
				  "°    "
			  )
		)
	      )
	      (progn			;когда 180°
		(setq Az 180.)
		(setq Az180 (- Az 180.))
		(set_tile "ln5"
			  (strcat "Азимут: "
				  (vl-princ-to-string Az)
				  "°"
				  "-"
				  (vl-princ-to-string Az180)
				  "°    "
			  )
		)
	      )
	    )				;if
	  )				;= x2 x1
	  (progn			;/= y2 y1 /= x2 x1
	    (if	(< x1 x2)
	      (progn
		(if (< y1 y2)
		  (progn
		    (setq Az (atan (/ (- x2 x1) (- y2 y1))))
		    (setq Az (atof (rtos (deg Az) 2 2)))
		    (setq Az180 (+ Az 180.))
		    (set_tile "ln5"
			      (strcat "Азимут: "
				      (vl-princ-to-string Az)
				      "°"
				      "-"
				      (vl-princ-to-string Az180)
				      "°    "
			      )
		    )
		  )
		  (progn
		    (setq
		      Az (+ pi (atan (/ (- x2 x1) (- y2 y1))))
		    )
		    (setq Az (atof (rtos (deg Az) 2 2)))
		    (setq Az180 (+ Az 180.))
		    (set_tile "ln5"
			      (strcat "Азимут: "
				      (vl-princ-to-string Az)
				      "°"
				      "-"
				      (vl-princ-to-string Az180)
				      "°    "
			      )
		    )
		  )
		)			;if < y1 y2
	      )
	      (progn			; > x1 x2
		(if (< y1 y2)
		  (progn
		    (setq Az
			   (+ (* 2. pi) (atan (/ (- x2 x1) (- y2 y1))))
		    )
		    (setq Az (atof (rtos (deg Az) 2 2)))
		    (setq Az180 (- Az 180.))
		    (set_tile "ln5"
			      (strcat "Азимут: "
				      (vl-princ-to-string Az)
				      "°"
				      "-"
				      (vl-princ-to-string Az180)
				      "°    "
			      )
		    )
		  )			;< y1 y2
		  (progn		;> y1 y2
		    (setq Az (+ pi (atan (/ (- x2 x1) (- y2 y1)))))
		    (setq Az (atof (rtos (deg Az) 2 2)))
		    (setq Az180 (- Az 180.))
		    (set_tile "ln5"
			      (strcat "Азимут: "
				      (vl-princ-to-string Az)
				      "°"
				      "-"
				      (vl-princ-to-string Az180)
				      "°    "
			      )
		    )
		  )			;> y1 y2
		)			;if < y1 y2
	      )				;> x1 x2
	    )				;if < x1 x2
	  )				;/= y2 y1 /= x2 x1
	)				;if = x2 x1
      )					;/= y2 y1
    )					;if = y2 y1
;;; -----------------------------------------------------------------
  ) ;_ end defun rpk
;;; -----ФУНКЦИЯ КОНТРОЛЯ ВВОДИМЫХ ЦИФРОВЫХ ДАННЫХ---
  (defun kont (val			;значение поля
	       key			;ключ поля или 'nil
	       n			;алгебраическое значение минимального числа
	       s			;допускаемое сочетание строковых символов или
					;nil - только числа
	       p			;0 - блокирует сообщение alert
					;    иное значение можно использовать для других целей
)
    (if	(= (type val) 'STR)
      (if (>= (distof val 1) n)
	val
					;ИНАЧЕ
	(if (and s
		 (= val s)
	    )
	  val
					;ИНАЧЕ
	  (progn
	    (if	key
	      (progn
					;выделение поля edit_box
		(mode_tile key 2)
		(mode_tile key 3)
	      )				;progn
	    )				;if key
	    (if	(distof val 1)
	      (setq s (strcat "\nВведенное число должно быть больше "
			      (rtos n 2 2)
		      )
	      )
					;
					;ИНАЧЕ
					;
	      (if s
		(setq s
		       (strcat "\nРазрешен ввод только символа \"" s "\".")
		)
					;
					;ИНАЧЕ
					;
		(setq s
		       (strcat
			 "\nРазрешен ввод только чисел"
			 "\nцелая и дробная части которых разделяются символом \".\" (точка)."
		       )
		)
	      )				;if s
	    )				;if
	    (if	(/= p 0)
	      (alert (strcat "                       ОШИБКА ВВОДА!"
			     "\n"
			     s
			     "."
		     )
	      )
	    )				;if (/= p 0)
	    'nil
	  )				;progn
	)				;if (= val s)
      )					;if
					;
					;ИНАЧЕ не предусмотренный вход 
					;
      (progn
	(alert "Обращение к функции не предусмотрено! СПРАВКА")
	(/ 1.0 0.0)
      )					;progn
    )					;if (= (type val) 'STR)
					;
					;НА ВЫХОДЕ: 
					;       val - значение контролируемого параметра
					;      'nil - обнаружена ошибка
  )					;defun kont
;;; ---------------------------------------------------------------
  (setq dcl_id (load_dialog "RAD_gomer.dcl"))

  (setq	step 2
	x1 0.0
	y1 0.0
	x2 0.0
	y2 0.0
	dfg_rad	75.0
  )

  (while (> step 1)

    (if	(null (new_dialog "RAD" dcl_id))
      (exit)
    )

    (set_tile "fgs_rad" (rtos dfg_rad))
    (set_tile "xp1" (rtos x1 2 5))
    (set_tile "yp1" (rtos y1 2 5))
    (set_tile "xp2" (rtos x2 2 5))
    (set_tile "yp2" (rtos y2 2 5))
    (action_tile "fgs_rad" "(kont $value $key 0 'nil 't)")
    (action_tile "сancel" "(done_dialog 0)")
    (action_tile
      "mousep"
      (strcat
	"(setq dfg_rad (atof (get_tile \"fgs_rad\")))"
	"(done_dialog 2)"
      )					;strcat
    )					;action_tile
;;; ------------------Вывод результатов----------------------------
    (action_tile
      "calc"
      (strcat
	"(setq dfg_rad (atof (get_tile \"fgs_rad\")))"
	"(setq x1 (atof (get_tile \"xp1\")))"
	"(setq y1 (atof (get_tile \"yp1\")))"
	"(setq x2 (atof (get_tile \"xp2\")))"
	"(setq y2 (atof (get_tile \"yp2\")))"
	"(rpk)"
       )				;strcat
    )					;action_tile
;;; ---------------------------------------------------------------
    (setq step (start_dialog))
    (cond
      ((= step 2)
       (setq pt1 (getpoint "\nУкажите точку: "))
       (setq pt2 (getpoint "\nУкажите вторую точку: " pt1))
       (if pt1
	 (setq x1 (car pt1)
	       y1 (cadr pt1)
	 )
       )
       (if pt2
	 (setq x2 (car pt2)
	       y2 (cadr pt2)
	 )
       )
      )
    )					;cond
  )					;while
  (unload_dialog dcl_id)
  (princ)
)

Код:

[Выделить все]

 RAD : dialog{
              label = "Название программы";
  : column{
    : text{
              label = "Проекция Меркатора. Система координат WGS-84"; }
 
    : edit_box{
              label = "Введите параллель, xx.xxxxx°:";
              key   = "fgs_rad";
         edit_width = 9;
         edit_limit = 8;
    }

  }
  : spacer{height=1;}

  : row{
  :column{
 //-----------------Первая точка-----------------
:boxed_column{
             label = "Первая точка";
      : edit_box{
             label = "X1:";
             value = "0";
             key   = "xp1";
             width = 15;
      }
      : edit_box{
             label = "Y1:";
             value = "0";
             key   = "yp1";
             width = 15;
      }
    }
//-------------------Вторая точка-----------------
:boxed_column{
            label = "Вторая точка";
      : edit_box{
            label = "X2:";
            value = "0";
            key   = "xp2";
            width = 15;
      }
      : edit_box{
            label = "Y2:";
            value = "0";
            key   = "yp2";
            width = 15;
      }
    }
    }//end column
    :column{
    : button{
           key   = "mousep";
           label = "< Указать";
          height = 4;
    }
    : button{
           key   = "calc";    
           label = "Вычислить >";   
          height = 4;
    }
}//end column

  }//end row
      : paragraph{
           label = "Результат вычислений";
          children_alignment
                 = centered;
           width = 20;
          height = 2; 
        : text{
           key   = "ln1";
          }
        : text{
           key   = "ln2";
          }
          : spacer {height=1;}
        : text{
           key   = "ln3";
          }
        : text{
           key   = "ln4";
          }
          : spacer {height=1;}
        : text{
           key   = "ln5";
          }
    }//end paragraph
  : row{
    fixed_height = true;
       alignment = top;
        spacer;
        : cancel_button{
          label  = "Закрыть";
          is_cancel
                 = true;       
          height = 2;
        }
  }//end row

  : column{
    fixed_height = true;
       alignment = bottom;
       : text{
           label = "Pavel_GP";
       alignment = right;
           }
        spacer;
  }//end column

}//end dialog

Спс. trushev вставил его код на проверку введённых данных.
Пысы: С вычислением расстояния могут возникнуть трудности, буду преодолевать их.

[trushev]

Сообщение от Pavel_GP Просьба если не трудно: доделать свой код , а именно внести проверку на точку

Сообщение от Pavel_GP в координатах x1 y1 x2 y2, при вводе вручную

Вставить (action_tile "fgs_rad" "(kont $value $key 0 'nil 't)") с заменой "fgs_rad" на ключи соответствующих полей "xp1", "yp1", "xp2", "yp2".

[Pavel_GP]

Всем Привет.
Закончил работать над своей программой, выкладываю ее конечный результат, дописал расчёт расстояния.
Если администрация не против могу выложить ее в готовые программы. Буду ждать от Вас ответа.

Код:

[Выделить все]

 ;;; Специальная гидрографическая программа
;;; для расчёта Азимута и Расстояния на эллипсоиде WGS84
;;; с использованием равноугольной цилиндрической проекции Меркатора
;;; 04.10.2015 г.
(defun dtr (a) (* pi (/ a 180.)))
(defun deg (r) (/ (* r 180.) pi))
(defun minu (d) (* (- d (fix d)) 60.))
(defun sek (m) (* (- m (fix m)) 60.))
;;; ---------------------------Основная функция----------------------
(defun C:RAD (/ rpk kont dcl_id step pt1 pt2 dfg_rad x1 y1 x2 y2)

  (defun rpk (/	    sfg2  ko	ll1_go	    ll1_g ll1_m	l1_g  l1_m
	      l1_s  ew	  mo1	ff1_m f1_g  f1_m  f1_s	ns    ll2_go
	      ll2_g ll2_m l2_g	l2_m  l2_s  mo2	  ff2_m	f2_g  f2_m
	      f2_s  Az180 ff1_g	ff2_g fg    Az	  em	l2_r  f1_r
	      l1_r  f2_r  ao	e1    e2    f_ps  a	b12   Bm
	      bo    c	  e1_2	e2_2  l12   Mm	  Nm	nym2  P
	      Q	    s
	     )
    (setq fg (dtr dfg_rad))
;;; -----------------параметры эллипсоида WGS84----------------------
    (setq ao   6378137.			;большая полуось
	  bo   6356752.3142		;малая полуось
	  f_ps (/ 1. 298.25722356)	;первое сжатие
	  e1   0.0818191909289067	;первый эксцентриситет
	  e1_2 (sqrt (/ (- (expt ao 2.) (expt bo 2.)) (expt bo 2.)))
					;второй эксцентриситет
	  e2_2 (expt e1_2 2.)
	  e2   (* f_ps (- 2. f_ps))
    )
    (setq sfg2 (expt (sin fg) 2.))
    (setq ko (/	(cos
		  fg
		)
		(expt (- 1. (* e2 sfg2)) 0.5)
	     )
    )
    (defun px (x) (/ x (* ao ko)))
;;; ---------Перевод координат из прямоугольных в географические--------
;;; ----------------------------Первая точка----------------------------
    (setq l1_r (abs (px x1)))
    (setq ll1_go (deg l1_r))
    (setq ll1_g (deg l1_r))
    (if	(> ll1_g 180)
      (setq ll1_g (- 180. (- ll1_g 180.)))
    )
    (setq ll1_m (minu ll1_g))
    (setq l1_g (fix ll1_g))
    (setq l1_m (fix ll1_m))
    (if	(< l1_m 10)
      (setq l1_m (strcat "0" (itoa (fix ll1_m))))
    )
    (setq l1_s (sek ll1_m))
    (if	(= (atof (rtos l1_s 2 2)) 60)
      (progn
	(setq l1_m (strcat "0" (itoa 1)))
	(setq l1_s (strcat "0" (rtos 0. 2 2)))
      )
      (progn
	(if (< l1_s 10)
	  (progn
	    (setq l1_s (strcat "0" (rtos l1_s 2 2)))
	  )
	  (progn
	    (setq l1_s (atof (rtos l1_s 2 2)))
	  )
	)				;if
      )
    )					;if
    (if	(> x1 0)
      (progn
	(if (< ll1_go 180)
	  (progn
	    (setq ew "” E")
	  )
	  (progn
	    (setq ew "” W")
	  )
	)				;if
      )
      (progn
	(if (< ll1_go 180)
	  (progn
	    (setq ew "” W")
	  )
	  (progn
	    (setq ew "” E")
	  )
	)				;if
      )
    )					;if
    (set_tile "ln2"
	      (strcat "Долгота: "
		      (vl-princ-to-string l1_g)
		      "°"
		      (vl-princ-to-string l1_m)
		      "'"
		      (vl-princ-to-string l1_s)
		      ew
	      )
    )
    (setq mo1 (- (/ pi 2.)
		 (* 2.
		    (atan (exp (/ (* -1. y1) (* ao ko))
			  )
		    )
		 )
	      )
    )
    (setq f1_r
	   (+ (+ (+ (+ mo1
		       (* (sin (* 2. mo1))
			  (+ (+	(+ (/ (expt e1 2.) 2.)
				   (* 5. (/ (expt e1 4.) 24.))
				)
				(/ (expt e1 6.) 12.)
			     )
			     (* 13. (/ (expt e1 8.) 360.))
			  )
		       )
		    )			;1
		    (* (sin (* 4. mo1))
		       (+ (+ (* 7. (/ (expt e1 4.) 48.))
			     (* 29. (/ (expt e1 6.) 240.))
			  )
			  (* 811. (/ (expt e1 8.) 11520.))
		       )
		    )
		 )			;2
		 (* (sin (* 6. mo1))
		    (+ (* 7. (/ (expt e1 6.) 120.))
		       (* 81. (/ (expt e1 8.) 1120.))
		    )
		 )
	      )				;3
	      (* (sin (* 8. mo1))
		 (* 4279. (/ (expt e1 8.) 161280.))
	      )
	   )				;4
    )					;setq
    (setq f1_r (abs f1_r))
    (setq ff1_g (deg f1_r))
    (setq ff1_m (minu ff1_g))
    (setq f1_g (fix ff1_g))
    (setq f1_m (fix ff1_m))
    (if	(< f1_m 10)
      (setq f1_m (strcat "0" (itoa (fix ff1_m))))
    )
    (setq f1_s (sek ff1_m))
    (if	(= (atof (rtos f1_s 2 2)) 60)
      (progn
	(setq f1_m (strcat "0" (itoa 1)))
	(setq f1_s (strcat "0" (rtos 0. 2 2)))
      )
      (progn
	(if (< f1_s 10)
	  (progn
	    (setq f1_s (strcat "0" (rtos f1_s 2 2)))
	  )
	  (progn
	    (setq f1_s (atof (rtos f1_s 2 2)))
	  )
	)				;if
      )
    )					;if
    (if	(= ff1_g 90)
      (progn
	(set_tile "ln1"
		  (strcat "  Широта:  "
			  "ПОЛЮС. ПРОВЕРЬ ДАННЫЕ!!!"
		  )
	)
      )
      (progn
	(if (> y1 0)
	  (progn
	    (setq ns "” N")
	  )
	  (progn
	    (setq ns "” S")
	  )
	)				;if
	(set_tile "ln1"
		  (strcat "  Широта:  "
			  (vl-princ-to-string f1_g)
			  "°"
			  (vl-princ-to-string f1_m)
			  "'"
			  (vl-princ-to-string f1_s)
			  ns
		  )
	)
      )
    )					;if
;;; --------------------------end Первая точка----------------------
;;; -------------------------Вторая точка---------------------------
    (setq l2_r (abs (px x2)))
    (setq ll2_go (deg l2_r))
    (setq ll2_g (deg l2_r))
    (if	(> ll2_g 180)
      (setq ll2_g (- 180. (- ll2_g 180.)))
    )
    (setq ll2_m (minu ll2_g))
    (setq l2_g (fix ll2_g))
    (setq l2_m (fix ll2_m))
    (if	(< l2_m 10)
      (setq l2_m (strcat "0" (itoa (fix ll2_m))))
    )
    (setq l2_s (sek ll2_m))
    (if	(= (atof (rtos l2_s 2 2)) 60)
      (progn
	(setq l2_m (strcat "0" (itoa 1)))
	(setq l2_s (strcat "0" (rtos 0. 2 2)))
      )
      (progn
	(if (< l2_s 10)
	  (progn
	    (setq l2_s (strcat "0" (rtos l2_s 2 2)))
	  )
	  (progn
	    (setq l2_s (atof (rtos l2_s 2 2)))
	  )
	)				;if
      )
    )					;if
    (if	(> x2 0)
      (progn
	(if (< ll2_go 180)
	  (progn
	    (setq ew "” E")
	  )
	  (progn
	    (setq ew "” W")
	  )
	)				;if
      )
      (progn
	(if (< ll2_go 180)
	  (progn
	    (setq ew "” W")
	  )
	  (progn
	    (setq ew "” E")
	  )
	)				;if
      )
    )					;if
    (set_tile "ln4"
	      (strcat "Долгота: "
		      (vl-princ-to-string l2_g)
		      "°"
		      (vl-princ-to-string l2_m)
		      "'"
		      (vl-princ-to-string l2_s)
		      ew
	      )
    )
    (setq mo2 (- (/ pi 2.)
		 (* 2.
		    (atan (exp (/ (* -1. y2) (* ao ko))
			  )
		    )
		 )
	      )
    )
    (setq f2_r
	   (+ (+ (+ (+ mo2
		       (* (sin (* 2. mo2))
			  (+ (+	(+ (/ (expt e1 2.) 2.)
				   (* 5. (/ (expt e1 4.) 24.))
				)
				(/ (expt e1 6.) 12.)
			     )
			     (* 13. (/ (expt e1 8.) 360.))
			  )
		       )
		    )			;1
		    (* (sin (* 4. mo2))
		       (+ (+ (* 7. (/ (expt e1 4.) 48.))
			     (* 29. (/ (expt e1 6.) 240.))
			  )
			  (* 811. (/ (expt e1 8.) 11520.))
		       )
		    )
		 )			;2
		 (* (sin (* 6. mo2))
		    (+ (* 7. (/ (expt e1 6.) 120.))
		       (* 81. (/ (expt e1 8.) 1120.))
		    )
		 )
	      )				;3
	      (* (sin (* 8. mo2))
		 (* 4279. (/ (expt e1 8.) 161280.))
	      )
	   )				;4
    )					;setq
    (setq f2_r (abs f2_r))
    (setq ff2_g (deg f2_r))
    (setq ff2_m (minu ff2_g))
    (setq f2_s (sek ff2_m))
    (setq f2_g (fix ff2_g))
    (setq f2_m (fix ff2_m))
    (if	(< f2_m 10)
      (setq f2_m (strcat "0" (itoa (fix ff2_m))))
    )
    (setq f2_s (sek ff2_m))
    (if	(= (atof (rtos f2_s 2 2)) 60)
      (progn
	(setq f2_m (strcat "0" (itoa 1)))
	(setq f2_s (strcat "0" (rtos 0. 2 2)))
      )
      (progn
	(if (< f2_s 10)
	  (progn
	    (setq f2_s (strcat "0" (rtos f2_s 2 2)))
	  )
	  (progn
	    (setq f2_s (atof (rtos f2_s 2 2)))
	  )
	)				;if
      )
    )					;if
    (if	(= ff2_g 90)
      (progn
	(set_tile "ln3"
		  (strcat "  Широта:  "
			  "ПОЛЮС. ПРОВЕРЬ ДАННЫЕ!!!"
		  )
	)
      )
      (progn
	(if (> y2 0)
	  (progn
	    (setq ns "” N")
	  )
	  (progn
	    (setq ns "” S")
	  )
	)				;if
	(set_tile "ln3"
		  (strcat "  Широта:  "
			  (vl-princ-to-string f2_g)
			  "°"
			  (vl-princ-to-string f2_m)
			  "'"
			  (vl-princ-to-string f2_s)
			  ns
		  )
	)
      )
    )					;if
;;; -----------------------end Вторая точка--------------------------
;;; ------------------------Расчёт Азимута---------------------------
    (if	(and (= y2 y1) (= x2 x1))
      (progn
	(set_tile "ln5"
		  (strcat "Азимут: "
			  "НЕВЕРНЫЕ ДАННЫЕ"
		  )
	)
      )
      (progn
	(cond ((and (= y2 y1) (> x2 x1))
	       (setq Az 90.)
	       (setq Az180 (+ Az 180.))
	      )
	      ((and (= y2 y1) (< x2 x1))
	       (setq Az 270.)
	       (setq Az180 (- Az 180.))
	      )
	      ((and (> y2 y1) (= x2 x1))
	       (setq Az 0.)
	       (setq Az180 (+ Az 180.))
	      )
	      ((and (< y2 y1) (= x2 x1))
	       (setq Az 180.)
	       (setq Az180 (- Az 180.))
	      )
	      ((and (< y1 y2) (< x1 x2))
	       (setq Az (atan (/ (- x2 x1) (- y2 y1))))
	       (setq Az (atof (rtos (deg Az) 2 2)))
	       (setq Az180 (+ Az 180.))
	      )
	      ((and (> y1 y2) (< x1 x2))
	       (setq Az (+ pi (atan (/ (- x2 x1) (- y2 y1)))))
	       (setq Az (atof (rtos (deg Az) 2 2)))
	       (setq Az180 (+ Az 180.))
	      )
	      ((and (< y1 y2) (> x1 x2))
	       (setq Az (+ (* 2. pi) (atan (/ (- x2 x1) (- y2 y1)))))
	       (setq Az (atof (rtos (deg Az) 2 2)))
	       (setq Az180 (- Az 180.))
	      )
	      ((and (> y1 y2) (> x1 x2))
	       (setq Az (+ pi (atan (/ (- x2 x1) (- y2 y1)))))
	       (setq Az (atof (rtos (deg Az) 2 2)))
	       (setq Az180 (- Az 180.))
	      )
	)				;end cond
	(set_tile "ln5"
		  (strcat "Азимут: "
			  (vl-princ-to-string Az)
			  "°"
			  "-"
			  (vl-princ-to-string Az180)
			  "°    "
		  )
	)
      )
    )					;end if
;;; --------------------------------------------------------------------
;;; ---------Расчёт Расстояния-Способ Гаусса-на эллипсоиде--------------
;;; ---------------Вспомогательные функции для расчёта------------------
    (setq b12 (- f2_r f1_r))
    (setq l12 (- l2_r l1_r))
    (setq Bm (/ (+ f1_r f2_r) 2.))
    (setq nym2 (* e2_2 (expt (cos Bm) 2.)))
    (setq c (* bo (+ 1. e2_2)))
    (setq Nm (/ c (sqrt (+ 1. nym2))))
    (setq Mm (/ Nm (+ 1. nym2)))
    (setq Q (* b12
	       Mm
	       (- 1.
		  (/ (+	(* 2. (expt l12 2.))
			(* (expt l12 2.) (expt (sin Mm) 2.))
		     )
		     24.
		  )
	       )
	    )
    )
    (setq P
	   (* l12
	      Nm
	      (cos Bm)
	      (+ 1.
		 (/ (- (expt b12 2.) (* (expt l12 2.) (expt (sin Bm) 2.)))
		    24.
		 )
	      )
	   )
    )
    (setq a (* l12
	       (sin Bm)
	       (+ 1.
		  (/ (-	(+ (* 3. (expt b12 2.)) (* 2. (expt l12 2.)))
			(* 2. (expt l12 2.) (expt (sin Bm) 2.))
		     )
		     24.
		  )
	       )
	    )
    )
    (setq s (sqrt (+ (expt Q 2.) (expt P 2.))))
    (set_tile "ln6"
	      (strcat "Расстояние: "
		      (vl-princ-to-string s)
		      " m"
	      )
    )
  ) ;_ end defun rpk
;;; -----ФУНКЦИЯ КОНТРОЛЯ ВВОДИМЫХ ЦИФРОВЫХ ДАННЫХ---
  (defun kont (val			;значение поля
	       key			;ключ поля или 'nil
	       n			;алгебраическое значение минимального числа
	       s			;допускаемое сочетание строковых символов или
					;nil - только числа
	       p			;0 - блокирует сообщение alert
					;    иное значение можно использовать для других целей
)
    (if	(= (type val) 'STR)
      (if (>= (distof val 1) n)
	val
					;ИНАЧЕ
	(if (and s
		 (= val s)
	    )
	  val
					;ИНАЧЕ
	  (progn
	    (if	key
	      (progn
					;выделение поля edit_box
		(mode_tile key 2)
		(mode_tile key 3)
	      )				;progn
	    )				;if key
	    (if	(distof val 1)
	      (setq s (strcat "\nВведенное число должно быть больше "
			      (rtos n 2 2)
		      )
	      )
					;
					;ИНАЧЕ
					;
	      (if s
		(setq s
		       (strcat "\nРазрешен ввод только символа \"" s "\".")
		)
					;
					;ИНАЧЕ
					;
		(setq s
		       (strcat
			 "\nРазрешен ввод только чисел"
			 "\nцелая и дробная части которых разделяются символом \".\" (точка)."
		       )
		)
	      )				;if s
	    )				;if
	    (if	(/= p 0)
	      (alert (strcat "                       ОШИБКА ВВОДА!"
			     "\n"
			     s
			     "."
		     )
	      )
	    )				;if (/= p 0)
	    'nil
	  )				;progn
	)				;if (= val s)
      )					;if
					;
					;ИНАЧЕ не предусмотренный вход 
					;
      (progn
	(alert "Обращение к функции не предусмотрено! СПРАВКА")
	(/ 1.0 0.0)
      )					;progn
    )					;if (= (type val) 'STR)
					;
					;НА ВЫХОДЕ: 
					;       val - значение контролируемого параметра
					;      'nil - обнаружена ошибка
  )					;defun kont
;;; ---------------------------------------------------------------
  (setq dcl_id (load_dialog "RAD.dcl"))

  (setq	step 2
	x1 0.0
	y1 0.0
	x2 0.0
	y2 0.0
	dfg_rad	75.0
  )

  (while (> step 1)

    (if	(null (new_dialog "RAD" dcl_id))
      (exit)
    )

    (set_tile "fgs_rad" (rtos dfg_rad))
    (set_tile "xp1" (rtos x1 2 5))
    (set_tile "yp1" (rtos y1 2 5))
    (set_tile "xp2" (rtos x2 2 5))
    (set_tile "yp2" (rtos y2 2 5))
    (action_tile "fgs_rad" "(kont $value $key 0 'nil 't)")
    (action_tile "xp1" "(kont $value $key 0 'nil 't)")
    (action_tile "xp2" "(kont $value $key 0 'nil 't)")
    (action_tile "yp1" "(kont $value $key 0 'nil 't)")
    (action_tile "yp2" "(kont $value $key 0 'nil 't)")
    (action_tile "сancel" "(done_dialog 0)")
    (action_tile
      "mousep"
      (strcat
	"(setq dfg_rad (atof (get_tile \"fgs_rad\")))"
	"(done_dialog 2)"
      )					;strcat
    )					;action_tile
;;; ------------------Вывод результатов----------------------------
    (action_tile
      "calc"
      (strcat
	"(setq dfg_rad (atof (get_tile \"fgs_rad\")))"
	"(setq x1 (atof (get_tile \"xp1\")))"
	"(setq y1 (atof (get_tile \"yp1\")))"
	"(setq x2 (atof (get_tile \"xp2\")))"
	"(setq y2 (atof (get_tile \"yp2\")))"
	"(rpk)"
       )				;strcat
    )					;action_tile
;;; ---------------------------------------------------------------
    (setq step (start_dialog))
    (cond
      ((= step 2)
       (setq pt1 (getpoint "\nУкажите точку: "))
       (setq pt2 (getpoint "\nУкажите вторую точку: " pt1))
       (if pt1
	 (setq x1 (car pt1)
	       y1 (cadr pt1)
	 )
       )
       (if pt2
	 (setq x2 (car pt2)
	       y2 (cadr pt2)
	 )
       )
      )
    )					;cond
  )					;while
  (unload_dialog dcl_id)
  (princ)
)

Код:

[Выделить все]

  RAD : dialog{
              label = "Расчёт Азимута и Расстояния";
  : column{
    : text{
              label = "Проекция Меркатора. Система координат WGS-84"; }
 
    : edit_box{
              label = "Введите параллель, xx.xxxxx°:";
              key   = "fgs_rad";
         edit_width = 9;
         edit_limit = 8;
    }

  }
  : spacer{height=1;}

  : row{
  :column{
 //-----------------Первая точка-----------------
:boxed_column{
             label = "Первая точка";
      : edit_box{
             label = "X1:";
             value = "0";
             key   = "xp1";
             width = 15;
      }
      : edit_box{
             label = "Y1:";
             value = "0";
             key   = "yp1";
             width = 15;
      }
    }
//-------------------Вторая точка-----------------
:boxed_column{
            label = "Вторая точка";
      : edit_box{
            label = "X2:";
            value = "0";
            key   = "xp2";
            width = 15;
      }
      : edit_box{
            label = "Y2:";
            value = "0";
            key   = "yp2";
            width = 15;
      }
    }
    }//end column
    :column{
    : button{
           key   = "mousep";
           label = "< Указать";
          height = 4;
    }
    : button{
           key   = "calc";    
           label = "Вычислить >";   
          height = 4;
    }
}//end column

  }//end row
      : paragraph{
           label = "Результат вычислений";
          children_alignment
                 = centered;
           width = 20;
          height = 2; 
        : text{
           key   = "ln1";
          }
        : text{
           key   = "ln2";
          }
          : spacer {height=1;}
        : text{
           key   = "ln3";
          }
        : text{
           key   = "ln4";
          }
          : spacer {height=1;}
        : text{
           key   = "ln5";
          }
          : spacer {height=1;}
        : text{
           key   = "ln6";
          }
    }//end paragraph
  : row{
    fixed_height = true;
       alignment = top;
        spacer;
        : cancel_button{
          label  = "Закрыть";
          is_cancel
                 = true;       
          height = 2;
        }
  }//end row

  : column{
    fixed_height = true;
       alignment = bottom;
       : text{
           label = "Pavel_GP";
       alignment = right;
           }
        spacer;
  }//end column

}//end dialog

Спасибо большое Всем кто помогал мне в её реализации.

Пысы: Кто будет ей пользоваться прошу обратить внимание на 2 и 3 строку кода .lsp

[gomer]

Раз уж ты так уверен в своей программе, скомпилируюй ее, напиши справку и кинь в даунлоад, только исходники не забудь

[Кулик Алексей aka kpblc]

А что функции преобразований как локальные не сделал?

[Pavel_GP]

Если закинуть их в локальные они перестают работать.
Перенес

Код:

[Выделить все]

 
(defun C:RAD (/ rpk kont dcl_id step pt1 pt2 dfg_rad x1 y1 x2 y2 dtr deg minu sek)

  (defun dtr (a) (* pi (/ a 180.)))
  (defun deg (r) (/ (* r 180.) pi))
  (defun minu (d) (* (- d (fix d)) 60.))
  (defun sek (m) (* (- m (fix m)) 60.))

  (defun rpk (/	     sfg2... 

теперь работают.

[gomer]

Сообщение от Pavel_GP Перенес

Именно такой подход я и называю хламом

[Pavel_GP]

Сообщение от gomer хламом

я ждал твоего возмущения... жестко и в точку., только не понятно даже и не собираюсь понимать чего твоя персона добивается... как-то по-детски. Тебя что-то беспокоит? Ты не ожидал такого математического решения моей задачи как у меня. И тебе распирает поэтому. В этих вопросов я просто умнее, смирись с этим. Ты в программных кодах шаришь, а я решаю поставленную задачу.
Пысы: для тебя лично повторюсь я НЕ программист!!!

[gomer]

Сообщение от Pavel_GP Тебя что-то беспокоит?

Ну, хорошо. Я расскажу еще раз. Однажды ко мне обратился заказчик и попросил сделать программу. Оказалось, что программу уже сделали до меня и выдали на руки заказчику, получив денежку. Возможно даже кто-то из местных. По-крайней мере призрак Полещука в ней бродил. Оказалось так же, что эта программа делала ровным счетом чуть менее, чем ничего. Но зато выглядела она увесисто... Так вот мне бы хотелось, чтоб если даже у меня и увели работу, то эта работа была выполнена качественно. Иначе какой в ней смысл.
Почему локальные функции - хлам? Потому что сегодня ты написал одну программу, завтра вторую, а через год у тебя будет 20 программ, в которых будут 100 одинаковых функций, определенных локально. А потом ты забудешь, что уже определил 20 раз функцию и воспользуешься встроенной, пару раз. А потом ты уже запутаешься в типах данных на входе и выходе и будешь городить еще функции для конвертации одного типа данных в другой и обратно. И наконец у тебя получится нечто подобное bgtools в которой из 150кб кода полезным будет максимум 20-50. При этом у тебя даже элементарной менюшки не окажется, не говоря уже о справке... Но не смотря на то, что ты все сделал правильно, тебе еще понадобится универсальный обработчик ошибок, но и он тебе не поможет. При этом тебе придется минимизировать комментарии, чтоб хоть как-то разобраться в написанном, а без комментариев ты все равно не разберешься. Не пройдет и 5 лет как ты будешь смотреть на свой, родной код, как... ну, в общем исступленно (это я тебе по собственному опыту говорю). А переписывать ты свой код будешь не раз и не два.
Вместо локальных функций в визуал лисп придумали проекты и компиляцию в с отдельным пространством имен. Это даже эффективней, чем создавать функции с "именными" префиксами. Единственный минус - исходники рано или поздно потеряются, но до тех пор много воды утечет...

[Кулик Алексей aka kpblc]

gomer, в данном конкретном случае локальные функции значительно более выгодны, чем глобальные: проект единственный, команда единственная и мусора лишнего вносить не надо. При условии предоставления только vlx / fas без исходников лично я даже смотреть в сторону такой программы не буду - черт его знает, что там нарисовано и как. Вычищать потом замучаешься.

----- добавлено через 37 сек. -----
Pavel_GP, ты бы обновил стартовый пост, указав окончательное решение...

[trushev]

Сообщение от gomer А переписывать ты свой код будешь не раз и не два.

Полностью согласен. Больше комментировать.
Кроме того,gomer, уже поднимал вопрос: добавить клавишу "Инфо" и посадить на нее описание работы программы.

[ShaggyDoc]

Сообщение от Кулик Алексей aka kpblc gomer, в данном конкретном случае локальные функции значительно более выгодны, чем глобальные: проект единственный, команда единственная и мусора лишнего вносить не надо. .

Это только сначала "проект единственный", а потом они начнут плодиться. Конечно, какие-то функции, которые никогда нигде больше не понадобятся, надо делать локальными.

Ну а такие, как rtd, dtr, kont, ввод данных и прочие универсальные надо сразу выносить в библиотеку.
А также надо избегать элементарных ошибок. Вот например в коде наивно написано:

Код:

[Выделить все]

        
       (setq pt1 (getpoint "\nУкажите точку: "))
       (setq pt2 (getpoint "\nУкажите вторую точку: " pt1))

Ну, а если пользователь не укажет pt1? Промажет, ESC нажмет и т.п. Он-то имеет право, а программист не имеет права допускать ошибки. Значит нужна проверка ввода - и первой и второй точек. Да и обработка ошибок нужна, чтобы программа могла работать не только в руках автора.

[Кулик Алексей aka kpblc]

ShaggyDoc, я же сказал, что "в данном конкретном случае". Я не говорил про потоковую разработку взаимоувязанных функций и команд. Если человек начнет заниматься подобной библиотекой / комплексом / как-хочется-так-и-называй, то вопрос исключения дублирования функционала встанет в полный рост. Но сейчас? Для этой одной задачи? ИМХО смысла нет.

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc Pavel_GP, ты бы обновил стартовый пост, указав окончательное решение...

1. Ув. Кулик Алексей aka kpblc стартовый пост не вижу смысла менять, он на свой вопрос получил ответ.
2. Окончательное решение лежит тут http://forum.dwg.ru/showthread.php?t=125631
3. Форумчане опять горячая дискуссия по поводу красоты написания кода, которые на результаты расчетов не вливают. С вашей точки зрения всё правильно глаголите, это ваше программисткое дело, ваш хлеб. Я для своей результат получил. Это уже отходы от темы топика. Создайте топик "с 0 и до релиза программы" и там можно оспаривать.
4. Вставил информацию по Вашим просьбам =)
5. Ув. gomer опять много текста и воды не в тему топика, что-то непонятно хочешь доказать, человеку который далек от программного дела.
6. И главное aka kpblc если с твоей точки зрения моя программа, которая лежит в готовых не актуальна или как-то не профессионально написана (оформлена), в твоей власти её удалить. Я возражать не буду и на профессионализм в вашем деле не претендую. Тему можно закрывать.

Всем спс. До встреч в новых топиках.

[Disney]

Сообщение от gomer Ну, хорошо. Я расскажу еще раз.

Сообщение от trushev Полностью согласен.

Сообщение от ShaggyDoc А также надо избегать элементарных ошибок.

Как бы всё правильно пишите, но а смысл?
Во-первых, автор уже писал

Сообщение от Pavel_GP я НЕ программист!!!

Во-вторых, чаше всё равно все учатся на своих ошибках, пускай так и дольше зато усваивается лучше.