Как дополнить код программы, чтобы данные вводились через диалоговое окно?

RomeO · 10.04.2017, 15:36

Приветствую специалистов! Прошу помощи вот в какой проблеме.
Есть программа, которая автоматически проставляет нумерацию (щелчок мышью - следующий номер). Так вот я решил сделать так, чтобы начальные данные (высота текста, префикс, суффикс, начальный номер) вводились не строкой, а в окошке. Нашел код окна, нашел как запустить окно из программы, а оно не работает.

Вот исходный код программы

Код:

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

 (vl-load-com)
(defun c:num (/ oldPref oldSuf oldStart curStr newNum
	        actDoc actSp oldEcho oldSize *error*)

  (defun *error* (msg)
    (setvar "CMDECHO" oldEcho)
    (princ)
    ); end *error*
  
  (vl-load-com)
  (if(not num:Size)(setq num:Size(getvar "DIMTXT")))
  (if(not num:Pref)(setq num:Pref ""))
  (if(not num:Suf)(setq num:Suf ""))
  (if(not num:Num)(setq num:Num 1))
  (setq oldPref num:Pref
        oldSuf num:Suf
        oldStart num:Num
	oldSize num:Size
	actDoc(vla-get-ActiveDocument
		(vlax-get-acad-object))
	oldEcho(getvar "CMDECHO")
	); end setq
  (setvar "CMDECHO" 0)
  (if(= (vla-get-ActiveSpace actDoc) 1)
    (setq actSp(vla-get-ModelSpace actDoc))
    (setq actSp(vla-get-PaperSpace actDoc))
    ); end setq
  (setq num:Size(getreal(strcat "\nSpecify text size <"(rtos num:Size)">: ")))
  (if(null num:Size)(setq num:Size oldSize))
  (setq num:Pref(getstring(strcat "\nEnter prefix <"num:Pref">: ")))
  (if(= "" num:Pref)(setq num:Pref oldPref))
  (if(= "#" num:Pref)(setq num:Pref ""))
  (setq num:Suf(getstring(strcat "\nEnter suffix <"num:Suf">: ")))
  (if(= "" num:Suf)(setq num:Suf oldSuf))
  (if(= "#" num:Suf)(setq num:Suf ""))
  (setq num:Num(getint(strcat "\nEnter start number <"(itoa num:Num)">: ")))
  (if(null num:Num)(setq num:Num oldStart))
(while T
  (setq curStr(strcat num:Pref(itoa num:Num)num:Suf))
    (while(vl-string-search "#" curStr)
      (setq curStr(vl-string-subst " " "#" curStr))
      ); end while
  (setq newNum(vla-AddText actSp
        curStr (vlax-3d-point'(0.0 0.0 0.0))num:Size))
  (vla-put-Alignment newNum acAlignmentMiddleCenter)
  (command "_.copybase" "0,0" (entlast) "")
  (command "_.erase" (entlast) "")
  (command "_.pasteclip" pause)
    (setq num:Num(1+ num:Num))
  ); end while
  (princ)
  ); end of c:num

Вот мой код:

Код:

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

 (vl-load-com)
(defun c:mp_num (/ dcl_id nub num:Size num:Pref num:Suf num:Num)
(defun num (num:Size num:Pref num:Suf num:Num / oldPref oldSuf oldStart curStr newNum
	        actDoc actSp oldEcho oldSize *error*)

  (defun *error* (msg)
    (setvar "CMDECHO" oldEcho)
    (princ)
    ); end *error*
  
  (vl-load-com)
  (if(not num:Size)(setq num:Size(getvar "DIMTXT")))
  (if(not num:Pref)(setq num:Pref ""))
  (if(not num:Suf)(setq num:Suf ""))
  (if(not num:Num)(setq num:Num 1))
  (setq oldPref num:Pref
        oldSuf num:Suf
        oldStart num:Num
	oldSize num:Size
	actDoc(vla-get-ActiveDocument
		(vlax-get-acad-object))
	oldEcho(getvar "CMDECHO")
	); end setq
  (setvar "CMDECHO" 0)
  (if(= (vla-get-ActiveSpace actDoc) 1)
    (setq actSp(vla-get-ModelSpace actDoc))
    (setq actSp(vla-get-PaperSpace actDoc))
    ); end setq
  (setq num:Size (atoi(get_tile "eb_Size")))
  (if(null num:Size)(setq num:Size oldSize))
  (setq num:Pref (atoi(get_tile "eb_Pref")))
  (if(= "" num:Pref)(setq num:Pref oldPref))
  (if(= "#" num:Pref)(setq num:Pref ""))
  (setq num:Suf (atoi(get_tile "eb_Suf")))
  (if(= "" num:Suf)(setq num:Suf oldSuf))
  (if(= "#" num:Suf)(setq num:Suf ""))
  (setq num:Num (atoi(get_tile "eb_Num")))
  (if(null num:Num)(setq num:Num oldStart))
(while T
  (setq curStr(strcat num:Pref(itoa num:Num)num:Suf))
    (while(vl-string-search "#" curStr)
      (setq curStr(vl-string-subst " " "#" curStr))
      ); end while
  (setq newNum(vla-AddText actSp
        curStr (vlax-3d-point'(0.0 0.0 0.0))num:Size))
  (vla-put-Alignment newNum acAlignmentMiddleCenter)
  (command "_.copybase" "0,0" (entlast) "")
  (command "_.erase" (entlast) "")
  (command "_.pasteclip" pause)
    (setq num:Num(1+ num:Num))
  ); end while
  (princ)
  ); end of c:num

  ; Диалоговое окно

  (setq dcl_id (load_dialog "mp_num.dcl"))
  (if(not (new_dialog "mp_num" dcl_id))(exit))

  (action_tile "accept" "(num) (done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")
  (setq ddi (start_dialog))

  (unload_dialog dcl_id)

  (if(= (ddi 1)) (num num:Size num:Pref num:Suf num:Num))
  (princ)
 )

Вот код окна:

Код:

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

 mp_num: dialog {label = "Нумерация"; // начало диалога

    : spacer{height=1;} // вставка пустой строки

    : edit_box {label = "Высота текста:"; key = "eb_Size"; edit_width=10; value = "";} 
    : edit_box {label = "Введите преффикс:"; key = "eb_Pref"; edit_width=10; value = "";} 
    : edit_box {label = "Введите суффикс:"; key = "eb_Suf"; edit_width=10; value = "";}
    : edit_box {label = "Начать с:"; key = "eb_Num"; edit_width=10; value = "";}

    : spacer{height=1;} 

    ok_cancel;   
}

После нажатия кнопки "ОК", выдает ошибку: "слишком мало аргументов"
Подскажите, что не правильно делаю?

Кулик Алексей aka kpblc · 10.04.2017, 16:38

У тебя на accept повешен код

Код:

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

(action_tile "accept" "(num) (done_dialog 1)")

А функция num имеет несколько аргументов. Их кто будет передавать?
Добавлю: смысла здесь вызывать num, по-моему, никакого нет. И я не уверен, что там можно обойтись без progn

valerik88 · 11.04.2017, 11:06

Цитата:

Сообщение от Кулик Алексей aka kpblc

И я не уверен, что там можно обойтись без progn

Можно, в action_tile без progn всё работает

Кулик Алексей aka kpblc · 11.04.2017, 11:40

Бога ради. Мне значительно проще сначала получить ответ от пользователя, а потом его обрабатывать. Но это дело вкуса.

RomeO · 11.04.2017, 22:36

Цитата:

Их кто будет передавать?

А вот этот код разве не передает?

Код:

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

 (if(= (ddi 1)) (num num:Size num:Pref num:Suf num:Num))

Или я что-то не правильно говорю

Цитата:

смысла здесь вызывать num, по-моему, никакого нет

А как же тогда выполнение запустить? Ведь как раз нажатие кнопки "ОК" и будет командой для начала выполнения кода num.
Если я убираю эти аргументы, то командная строка ругается неверная функция: 1
Пытался покопаться в progn, но что-то ничего не нашел. Может наводочку какую дадите

valerik88 · 12.04.2017, 07:36

Цитата:

Сообщение от RomeO

Может наводочку какую дадите

Дык дали уже наводочку, вы не поняли.
в этой строке (action_tile "accept" "(num) (done_dialog 1)") функция num используется без аргументов, тогда как определена она с аргументами

VVA · 13.04.2017, 20:26

Соглашусь с Алексеем. Никакого смысла вызывать num этой строке (action_tile "accept" "(num) (done_dialog 1)") нет, так как по нажатию OK диалог завершится с кодом возврата 1 (done_dialog 1) и далее if запустит num правильно
Строчки должны выглядеть так

Код:

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

(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")

RomeO · 13.04.2017, 22:30

Ну теперь совсем плохо. При нажатии кнопки ОК выдает ошибку: неверная функция 1. Ох, не везет мне что-то с этими кодами...

И главное, понять не могу где ошибка. Отладка показывает, что функция num не вызывается (т.е выполнение кода останавливается в конце диалога).

roaa · 14.04.2017, 00:04

Не проверял

Код:

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

 
 (vl-load-com)
(defun c:mp_num (/ dcl_id num num:Size num:Pref num:Suf num:Num)
(defun num (num:Size num:Pref num:Suf num:Num /  curStr newNum
	        actDoc actSp oldEcho *error*)

  (defun *error* (msg)
    (setvar "CMDECHO" oldEcho)
    (princ)
    ); end *error*
  
  (vl-load-com)
  (setq actDoc 
	             (vla-get-ActiveDocument
		             (vlax-get-acad-object))
	      oldEcho (getvar "CMDECHO")
	); end setq
  (setvar "CMDECHO" 0)
  (if(= (vla-get-ActiveSpace actDoc) 1)
    (setq actSp (vla-get-ModelSpace actDoc))
    (setq actSp (vla-get-PaperSpace actDoc))
    ); end setq
  (while 
    (setq curStr (strcat num:Pref num:Num num:Suf)
          newNum 
                 (vla-AddText actSp curStr 
                   (vlax-3d-point (getpont "\nУкажите точку вставки:"))
                   (atoi num:Size)
                 )
    )
  (vla-put-Alignment newNum acAlignmentMiddleCenter)
  (setq num:Num (itoa (1+ (atoi num:Num))))
  )
  (setvar "CMDECHO" oldEcho)
  (princ)
); end of c:num

  ; Диалоговое окно

  (if (not num:Size)(setq num:Size (rtos (getvar "DIMTXT") 2 1)))
  (if (not num:Pref)(setq num:Pref ""))
  (if (not num:Suf)(setq num:Suf ""))
  (if (not num:Num)(setq num:Num "1"))

  (setq dcl_id (load_dialog "mp_num.dcl"))
  (if(not (new_dialog "mp_num" dcl_id))(exit))
  
;;; функция, вызываемая по OK
  (defun ok_tab (/)
    (setq num:Size (get_tile "eb_Size")
          num:Pref (get_tile "eb_Pref")
          num:Suf (get_tile "eb_Suf")
          num:Num (get_tile "eb_Num")
    )
  
  ) ;_ end defun
  
  (set_tile "eb_Size" num:Size)
  (set_tile "eb_Pref" num:Pref)
  (set_tile "eb_Suf" num:Suf)
  (set_tile "eb_Num" num:Num)

  (action_tile "accept" "(ok_tab)(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")
  (setq ddi (start_dialog))
  (unload_dialog dcl_id)
  (if(= (ddi 1))(num num:Size num:Pref num:Suf num:Num))
  (princ)
 )

Кулик Алексей aka kpblc · 14.04.2017, 09:02

Цитата:

Сообщение от RomeO

При нажатии кнопки ОК выдает ошибку: неверная функция 1.

Если правильно ввел action_tile, то не должно. ПОказывай свой код.

RomeO · 14.04.2017, 10:24

Да верно все. Все прошерстил, ничего не понимаю уже. Теперь (после советов уважаемого roaa) выдает неверный аргумент и возвращает stringp 2.5. Что это за аргумент такой не понятно.
Вот подкорректированный код

Код:

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

 (vl-load-com)
(defun c:mp_num (/ dcl_id nub num:Size num:Pref num:Suf num:Num)
(defun num (num:Size num:Pref num:Suf num:Num / oldPref oldSuf oldStart curStr newNum
	        actDoc actSp oldEcho oldSize *error*)

  (defun *error* (msg)
    (setvar "CMDECHO" oldEcho)
    (princ)
    ); end *error*
  
  (vl-load-com)
  (if(not num:Size)(setq num:Size(getvar "DIMTXT")))
  (if(not num:Pref)(setq num:Pref ""))
  (if(not num:Suf)(setq num:Suf ""))
  (if(not num:Num)(setq num:Num 1))
  (setq oldPref num:Pref
        oldSuf num:Suf
        oldStart num:Num
	oldSize num:Size
	actDoc(vla-get-ActiveDocument
		(vlax-get-acad-object))
	oldEcho(getvar "CMDECHO")
	); end setq
  (setvar "CMDECHO" 0)
  (if(= (vla-get-ActiveSpace actDoc) 1)
    (setq actSp(vla-get-ModelSpace actDoc))
    (setq actSp(vla-get-PaperSpace actDoc))
    ); end setq
  (setq num:Size (atoi(get_tile "eb_Size")))
  (if(null num:Size)(setq num:Size oldSize))
  (setq num:Pref (atoi(get_tile "eb_Pref")))
  (if(= "" num:Pref)(setq num:Pref oldPref))
  (if(= "#" num:Pref)(setq num:Pref ""))
  (setq num:Suf (atoi(get_tile "eb_Suf")))
  (if(= "" num:Suf)(setq num:Suf oldSuf))
  (if(= "#" num:Suf)(setq num:Suf ""))
  (setq num:Num (atoi(get_tile "eb_Num")))
  (if(null num:Num)(setq num:Num oldStart))
(while T
  (setq curStr(strcat num:Pref(itoa num:Num)num:Suf))
    (while(vl-string-search "#" curStr)
      (setq curStr(vl-string-subst " " "#" curStr))
      ); end while
  (setq newNum(vla-AddText actSp
        curStr (vlax-3d-point'(0.0 0.0 0.0))num:Size))
  (vla-put-Alignment newNum acAlignmentMiddleCenter)
  (command "_.copybase" "0,0" (entlast) "")
  (command "_.erase" (entlast) "")
  (command "_.pasteclip" pause)
    (setq num:Num(1+ num:Num))
  ); end while
  (princ)
  ); end of c:num

  ; Диалоговое окно

  (setq dcl_id (load_dialog "mp_num.dcl"))
  (if(not (new_dialog "mp_num" dcl_id))(exit))
(defun ok_tab (/)
	(setq num:Size (get_tile "eb_Size")
	      num:Pref (get_tile "eb_Pref")
	      num:Suf (get_tile "eb_Suf")
	      num:Num (get_tile "eb_Num")
	    )
  )

(set_tile "eb_Size" num:Size)
  (set_tile "eb_Pref" num:Pref)
  (set_tile "eb_Suf" num:Suf)
  (set_tile "eb_Num" num:Num)
  
  (action_tile "accept" "(ok_tab)(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")
  (setq ddi (start_dialog))

  (unload_dialog dcl_id)

  (if(= (ddi 1)) (num num:Size num:Pref num:Suf num:Num))
  (princ)
 )

И снова тормозит после нажатия кнопки ОК. Только теперь остановка на коде

Код:

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

 (if(not num:Size)(setq num:Size(getvar "DIMTXT")))

roaa · 14.04.2017, 10:39

Цитата:

Сообщение от RomeO

возвращает stringp 2.5

поправил код выше

frostmourn · 14.04.2017, 11:00

Цитата:

Сообщение от roaa

поправил код выше

Цитата:

itoa

Гмм... Может, всё-таки rtos?

gomer · 14.04.2017, 12:03

Что вы тут такое курите?

VVA · 14.04.2017, 14:58

Цитата:

Сообщение от roaa

Не проверял

Проверял

Код:

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

(defun c:mp_num (/ dcl_id nub)
(defun num ( / oldPref oldSuf oldStart curStr newNum
	        actDoc actSp oldEcho oldSize *error*)
  (defun *error* (msg)
    (setvar "CMDECHO" oldEcho)
    (princ)
    ); end *error*
  (vl-load-com)
  (if(not num:Size)(setq num:Size(getvar "DIMTXT")))
  (if(not num:Pref)(setq num:Pref ""))
  (if(not num:Suf)(setq num:Suf ""))
  (if(not num:Num)(setq num:Num 1))
  (setq oldPref num:Pref
        oldSuf num:Suf
        oldStart num:Num
	oldSize num:Size
	actDoc(vla-get-ActiveDocument
		(vlax-get-acad-object))
	oldEcho(getvar "CMDECHO")
	); end setq
  (setvar "CMDECHO" 0)
  (if(= (vla-get-ActiveSpace actDoc) 1)
    (setq actSp(vla-get-ModelSpace actDoc))
    (setq actSp(vla-get-PaperSpace actDoc))
    ); end setq
  (if(null num:Size)(setq num:Size oldSize))
  (if(= "" num:Pref)(setq num:Pref oldPref))
  (if(= "#" num:Pref)(setq num:Pref ""))
  (if(= "" num:Suf)(setq num:Suf oldSuf))
  (if(= "#" num:Suf)(setq num:Suf ""))
  (if(null num:Num)(setq num:Num oldStart))
(while T
  (setq curStr(strcat num:Pref(itoa num:Num)num:Suf))
    (while(vl-string-search "#" curStr)
      (setq curStr(vl-string-subst " " "#" curStr))
      ); end while
  (setq newNum(vla-AddText actSp
        curStr (vlax-3d-point'(0.0 0.0 0.0))num:Size))
  (vla-put-Alignment newNum acAlignmentMiddleCenter)
  (command "_.copybase" "0,0" (entlast) "")
  (command "_.erase" (entlast) "")
  (command "_.pasteclip" pause)
    (setq num:Num(1+ num:Num))
  ); end while
  (princ)
  ); end of c:num
(defun ok_tab (/)
	(setq num:Size (atof(get_tile "eb_Size"))
	      num:Pref (get_tile "eb_Pref")
	      num:Suf (get_tile "eb_Suf")
	      num:Num (atoi(get_tile "eb_Num"))
	    )
  )
  (vl-load-com)
  (if(not num:Size)(setq num:Size(getvar "DIMTXT")))
  (if(not num:Pref)(setq num:Pref ""))
  (if(not num:Suf)(setq num:Suf ""))
  (if(not num:Num)(setq num:Num 1))
  (setq dcl_id (load_dialog "mp_num.dcl"))
  (if(not (new_dialog "mp_num" dcl_id))(exit))
(set_tile "eb_Size" (rtos num:Size 2 2))
  (set_tile "eb_Pref" num:Pref)
  (set_tile "eb_Suf" num:Suf)
  (set_tile "eb_Num" (VL-PRINC-TO-STRING num:Num))
  
  (action_tile "accept" "(progn(ok_tab)(done_dialog 1))")
  (action_tile "cancel" "(done_dialog 0)")
  (setq ddi (start_dialog))
  (unload_dialog dcl_id)
  (if(= ddi 1)(num))
  (princ)
 )

roaa · 14.04.2017, 15:02

Цитата:

Сообщение от frostmourn

Гмм... Может, всё-таки rtos?

Да уж...не проверял

RomeO · 14.04.2017, 16:22

Ура! Заработало! Еще лучше, чем предполагалось! Благодарю всех за помощь и советы. Особено ув. VVA, сам бы в жизни не допер.

gomer · 14.04.2017, 19:12

Цитата:

Сообщение от VVA

Проверял

первый мастдай - переопределение глобальной функции *error*использование в ней локальной переменной...
второй локальный армагедец - вот это

Цитата:

Сообщение от VVA

(action_tile "accept" "(progn(ok_tab)(done_dialog 1))")

ну, во-первых, зачем использовать action_tile, если можно не использовать. во-вторых, зачем называть функцию отклика по лайбе кнопки, если у нее есть имя... в-третьих, функция отклика должна отражать событие, то есть клик по кнопке в данном случае, и что такое таб тогда? ну, и в-четвертых, почему нельзя предусмотреть в функции отклика закрытие диалога, вместо того чтоб городить s-выражения в строке?
остальные армагедцы не так значительны,но их достаточно

VVA · 15.04.2017, 09:00

gomer, Мое сообщение относится к проверке того, что после исправлений код топикстартера запустится и выполнится, а не вывалится по фатал error. Переписывать задачи не стояло.
Из твоего сообщения согласится можно только со вторым абзацем.
А по поводу *error* - нет там переопределение глобальной функции. Этот прием известен достаточно давно.

Код:

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

(defun test_error (  / *error* )
  (defun *error* (msg)
    (princ "\nОшибка в test_error")
    (princ)
    )
  (/ 2 0.)
  )

Цитата:

Команда: (test_error)
Ошибка в test_error
Команда: (/ 2 0.)
; ошибка: деление на нуль

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Эвакуация из подвала через окно, через соседнее помещение	Route	Прочее. Архитектура и строительство	7	24.03.2017 16:18
Tekla Structures. Как добавить в диалоговое окно пользовательского компонента битовую маску болтов.	ashas-	Tekla	2	25.12.2015 11:57
Как вернуть диалоговое окно "Инф-я о замистителях"(Autocad 2004,2008)?	wiznv	AutoCAD	3	07.04.2011 06:44
При команде Open не открывается диалоговое окно	Jull	AutoCAD	4	28.02.2006 11:19