[Tonic]

Ну вот, пытаюсь постичь азы DCL, а всё никак.
Задача такая: при загрузке lisp-программы появляется диалоговое окно:
Длина - edit1 (значение по умолчанию 4)
Угол - edit2 (значение по умолчанию 60)
Направление: "начало-конец" (*) "конец-начало" (*) ;две радиокнопки
OK CANCEL

Заполняем поля "Длина" (длина каждой "шляпки" стрелки) и "Угол" (угол между "палочками шляпки"), указываем одну из радиокнопок, нажимаем "ОК". Окошко закрывается. Из командной строки запрашивается первая точка стрелки, потом вторая. Если выбрано "Начало-конец", стрелка строится от первой точки ко второй, и "шляпка" рисуется у второй точки (где конец). Если выбрано "Конец-начало", пользователь сначала указывает конечную точку, потом начальную.
Нажимаем "ОК", стрелка строится. Из командной строки запрос: "Устраивает? <да>". Если не устраивает, снова открывается окошко. Но это уже сложней.

Может, у кого-то есть подобные наработки или советы! Что-то пока не очень-то получается =/

[fixo]

Не идеально конечно но вроде работает

Lisp файл:

Код:

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

;;===================== arr.lsp ======================;;
(defun dtr (a) 
(* pi (/ a 180.0)))

(defun C:arw (/	al     ang    angl   ar	    dcl_id ep	  flag	 leng
		msg1   msg2   p1     p2	    pt1	   pt2	  sp
		userclick
	       )
  (setq dcl_id (load_dialog "arr.dcl")) 
  (if (not (new_dialog "arrows" dcl_id)) 
    (exit) 
  )
  
  (action_tile "ln" "(setq leng (atof $value))")
  (action_tile "an" "(setq ang (atof $value))")
  (action_tile "def" "(progn (setq leng (atof (get_tile \"ln\")))
                             (setq ang (atof (get_tile \"an\"))))")
  (action_tile "nk" "(progn (set_tile \"kn\" \"0\")(setq flag T))")
  (action_tile "kn" "(progn (set_tile \"nk\" \"0\")(setq flag nil))")
  (action_tile "accept" "(done_dialog 1)(setq userclick T)")
  (action_tile "cancel" "(done_dialog 0)(setq userclick nil)")
  (start_dialog) 
  (unload_dialog dcl_id) 

  (if userclick
    (progn
      (if flag
	(progn
	(setq msg1 "\n  Начальная точка >>"
	      msg2 "\n Конечная точка "))
	(progn
	(setq msg1 "\n  Конечная точка >>"
	      msg2 "\n Конечная точка ")))
;;;    (alert (strcat "Длина: " (vl-princ-to-string leng)
;;;		   "\nУгол: " (vl-princ-to-string ang)
;;;		   "\nНаправление: " (if flag "Начало-Конец" "Конец-Начало")))
    (setq p1 (getpoint msg1)
	  p2 (getpoint p1 msg2)
	  )
      (if flag (progn
		 (setq sp p1
		       ep p2))
	       (progn
		 (setq sp p2
		       ep p1)))
 (setq angl (angle sp ep)
	  al (+ angl (dtr (/ ang 2)))
	  ar (- angl (dtr (/ ang 2)))
	  pt1 (polar sp al leng)
          pt2 (polar sp ar leng)
	  )
(entmake (list '(0 . "LINE")
                '(100 . "AcDbEntity")
                '(100 . "AcDbLine")
                (cons 10 pt1)
                (cons 11 sp)
          )
)
(entmake (list '(0 . "LINE")
                '(100 . "AcDbEntity")
                '(100 . "AcDbLine")
                (cons 10 sp)
                (cons 11 pt2)
          )
)
(entmake (list '(0 . "LINE")
                '(100 . "AcDbEntity")
                '(100 . "AcDbLine")
                (cons 10 p1)
                (cons 11 p2)
          )
)      
)
(alert "Действие отменено пользователем")
) 
(princ)
)
;;===================== end of arr.lsp ================;;

DCL файл:

Код:

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

;;===================== arr.dcl ======================;;
arrows : dialog {label = "Рисование стрелки";
    spacer ;
   : column {label = "Параметры стрелки";
   : edit_box {label = "Длина стрелки, мм:";
               key = "ln";
               value = "4";
               edit_limit = 8;
               edit_width = 8;}
   : edit_box {label = "Угол стрелки, град.:";
               value = "60";
               key = "an";
               edit_limit = 8;
               edit_width = 8;}
   spacer ;
   : toggle {label = "Принять размеры по умолчанию";
    key = "def";
   }
   }
   spacer ;
   : column {label = "Направление отрисовки";
   : radio_button {label = "Начало-Конец";
             key = "nk";}
   : radio_button {label = "Конец-Начало";
             key = "kn";}
   spacer ;         
   }
  spacer;
    ok_cancel;   
}  
;;================= end of arr.dcl =================;;

~'J'~

[Tonic]

Спасибо за участие! У меня не заработала - пишет, ошибка: "line1 sintax error in ";" Это в Брикскаде. А Автокад пишет "Команда: arw
; ошибка: завершить / выйти прервать"

[fixo]

Оба файла должны обязательно
находиться в одной папке, причем
в той же, где и чертеж

~'J'~

[fixo]

Скачивай отсюда
http://webfile.ru/1465668

~'J'~

[Tonic]

Виноват =) Это я из dcl-файла в начале и в конце не убрал ;;;; - "комментарии" (когда копировал).
Всё работает, и очень даже хорошо! Разве что "конец-начало" перепутано с "начало-конец" =)
Ну и нет предложения "Устраивает?" (не изменять?), но это не сильно важно. Думаю, и этого хватит.
Спасибо за помощь!
Кстати, Вы можете рекомендовать какие-нибудь книги/статьи по DCL в Интернете? Что-то я мало чего нашёл интересного...

[Tonic]

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

DCL:

arrows : dialog {label = "Рисование стрелки"; spacer ; : column {label = "Параметры стрелки"; : edit_box {label = "Длина стрелки:"; key = "ln"; value = "4"; edit_limit = 8; edit_width = 8;} : edit_box {label = "Угол стрелки, град.:"; value = "60"; key = "an"; edit_limit = 8; edit_width = 8;} spacer ; : toggle {label = "Принять размеры по умолчанию"; key = "def"; value = "1"; } } spacer ; : column {label = "Направление отрисовки"; : radio_button {label = "Конец-Начало"; key = "nk";} : radio_button {label = "Начало-Конец"; key = "kn"; value = "1";} spacer ; } spacer; ok_cancel; spacer; }

LSP:

(Defun dtr (a) ; Подпрограмма перевода угла в радианы (* pi (/ a 180.0))); end defun dtr (Defun C:arw (/ al ang angl ar dcl_id ep flag leng msg1 msg2 p1 p2 pt1 pt2 sp userclick) (setq i 2) (while (= i 2) (Setq dcl_id (load_dialog "arr.dcl")) ; Загрузка файла диалогового окна (If (Not (new_dialog "arrows" dcl_id)) (exit) ); End if (Setq MstKoeff 100) (Action_tile "ln" "(setq leng (* MstKoeff (atof $value)))"); Извлечение значения длины из поля edit (Action_tile "an" "(setq ang (atof $value))"); Извлечение значения угла из поля edit ; (Action_tile "def" "(progn (setq leng (* MstKoeff (atof (get_tile \"ln\")))); Если принимаются умолчания ; (setq ang (atof (get_tile \"an\"))))") (Action_tile "def" "(progn (setq leng (* MstKoeff 4)); Если принимаются умолчания (setq ang 60) (set_tile \"ln\" \"4\") (set_tile \"an\" \"60\") )") (Action_tile "nk" "(progn (set_tile \"kn\" \"0\")(setq flag T))"); Действие при выборе "Конец-Начало" (Action_tile "kn" "(progn (set_tile \"nk\" \"0\")(setq flag nil))"); Действие при выборе "Начало-Конец" (Action_tile "accept" "(done_dialog 1)(setq userclick T)"); Действие при нажатии ОК (Action_tile "cancel" "(done_dialog 0)(setq userclick nil)"); Действие при нажатии CANCEL (Start_dialog) (Unload_dialog dcl_id) (If userclick (Progn ; Если нажата кнопка ОК... (If flag (Progn ;... и выбрано "Конец-Начало" (Setq msg1 "\n Конечная точка >>" msg2 "\n Начальная точка >>")) (Progn ;... и выбрано "Начало-Конец" (Setq msg1 "\n Начальная точка >>" msg2 "\n Конечная точка >>")) ); End if flag (Setq p1 (Getpoint msg1) ; Ввод первой точки p2 (Getpoint p1 msg2) ; Ввод второй точки ) (If flag (Setq sp p1 ep p2); Если выбрано "Конец-Начало" (Setq sp p2 ep p1); Если выбрано "Начало-Конец" ); End if flag (Setq angl (Angle sp ep); Угол между точками и осью ОХ al (+ angl (dtr (/ ang 2))); Угол первой "шляпки" стрелки ar (- angl (dtr (/ ang 2))); Угол второй "шляпки" стрелки pt1 (Polar sp al leng); Координаты точки конца первой "шляпки" pt2 (Polar sp ar leng); Координаты точки конца второй "шляпки") ); End setq (Entmake (List '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine") (cons 10 pt1) (cons 11 sp))) (Setq l1 (entlast)) (Entmake (List '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine") (cons 10 sp) (cons 11 pt2))) (Setq l2 (entlast)) (Entmake (List '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine") (cons 10 p1) (cons 11 p2))) (Setq l3 (entlast)) (Setq reply (getstring "\nУстраивает или изменить? <не изменять> [1=не изменять 2=изменить]")) (If (= reply "2") (progn (entdel l1) (entdel l2) (entdel l3) (setq i 2) ); End progn (progn (setq i 1) (princ) ) ); end if ); End progn (setq i 1) ); End if );while (princ) ); End defun arw

[Tonic]

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