[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

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

[Кулик Алексей 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]

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