Диалги ввода двух строк
(defun ru-dlg-get-two-number (caption label1 default1
min1 max1 label2
default2 min2 max2
xml_file_name1 xml_file_name2
/ end err_str
lst num1 num2
result str1 str2
)
;|
Ввод двух чисел
(ru-dlg-get-two-number
"Размеры пилястры"
"Длина вдоль стены"
640
120 1000
"Ширина перпендикулярно стене"
380 120 6000
"options\wall_w.xml"
"options\wall_w.xml"
)
|;
(while (not end)
(if (setq lst (ru-dlg-get-two-string
caption
label1
(vl-princ-to-string default1)
t
label2
(vl-princ-to-string default2)
t
t
xml_file_name1
xml_file_name2
) ;_ end of ru-dlg-get-two-string
) ;_ end of setq
(progn
(setq err_str ""
str1 (car lst)
str2 (cadr lst)
num1 (atof str1)
num2 (atof str2)
) ;_ end of setq
(if (< num1 min1)
(setq err_str (strcat err_str
"
"
label1
"="
str1
" меньше допустимого значения "
(vl-princ-to-string min1)
) ;_ end of strcat
) ;_ end of setq
) ;_ end of if
(if (> num1 max1)
(setq err_str (strcat err_str
"
"
label1
"="
str1
" больше допустимого значения "
(vl-princ-to-string max1)
) ;_ end of strcat
) ;_ end of setq
) ;_ end of if
(if (< num2 min2)
(setq err_str (strcat err_str
"
"
label2
"="
str2
" меньше допустимого значения "
(vl-princ-to-string min2)
) ;_ end of strcat
) ;_ end of setq
) ;_ end of if
(if (> num2 max2)
(setq err_str (strcat err_str
"
"
label2
"="
str2
" больше допустимого значения "
(vl-princ-to-string max2)
) ;_ end of strcat
) ;_ end of setq
) ;_ end of if
(if (/= err_str "")
(ru-msg-alert
(strcat caption
"
Обнаружены ошибки: "
err_str
"
Повторите ввод!"
) ;_ end of strcat
) ;_ end of ru-msg-alert
(setq end t
result (list num1 num2)
) ;_ end of setq
) ;_ end of if
) ;_ end of progn
(setq end t)
) ;_ end of if
) ;_ end of while
result
) ;_ end of defun
(defun ru-dlg-get-two-string (caption label1
default1 disable_empty1
label2 default2
disable_empty2 Visible2
xml_file_name1 xml_file_name2
/ command_line
continue reason
result tmp_str
)
;|
;; XMLFileName передавать относительно
(ru-dlg-get-two-string
"Размеры пилястры"
"Длина вдоль стены"
"640"
t
"Ширина перпендикулярно стене"
"380"
t
t
"options\wall_w.xml"
"options\wall_w.xml"
) ;_ end of ru-dlg-get-two-string
(ru-dlg-get-two-string
"Образец штриховки"
"Диаметр магистрали"
"1000"
t
"Диаметр ответвления"
"500"
t
nil
"options\diam_nominal.xml"
"options\diam_nominal.xml"
)
|;
(setq command_line (strcat (ru-file-bin "ruGetDoubleStr.exe") " ru")
result (list default1 default2)
continue t
) ;_ end of setq
(ru-reg-delete-tmp-sub-key "GetDoubleString")
(ru-reg-write-tmp-string "GetDoubleString" "Caption" caption)
(ru-reg-write-tmp-string "GetDoubleString" "LabelStr1" label1)
(ru-reg-write-tmp-string "GetDoubleString" "LabelStr2" label2)
(ru-reg-write-tmp-string
"GetDoubleString"
"DisableEmpty1"
(ru-conv-bool-to-str disable_empty1)
) ;_ end of ru-reg-write-tmp-string
(ru-reg-write-tmp-string
"GetDoubleString"
"DisableEmpty2"
(ru-conv-bool-to-str disable_empty2)
) ;_ end of ru-reg-write-tmp-string
(ru-reg-write-tmp-string
"GetDoubleString"
"CaptureImageEnabled"
(ru-conv-bool-to-str (ru-user-may-xml-edit))
) ;_ end of ru-reg-write-tmp-string
(ru-reg-write-tmp-string
"GetDoubleString"
"Visible2"
(ru-conv-bool-to-str visible2)
) ;_ end of ru-reg-write-tmp-string
(ru-reg-write-tmp-string
"GetDoubleString"
"XmlFileName1"
xml_file_name1
) ;_ end of ru-reg-write-tmp-string
(ru-reg-write-tmp-string
"GetDoubleString"
"XmlFileName2"
xml_file_name2
) ;_ end of ru-reg-write-tmp-string
(ru-reg-write-tmp-string "GetDoubleString" "AttribName1" "sdata")
(ru-reg-write-tmp-string "GetDoubleString" "AttribName2" "sdata")
(ru-reg-write-tmp-string
"GetDoubleString"
"XmlImagesDir"
(ru-dirs-menu-xml-images)
) ;_ end of ru-reg-write-tmp-string
(ru-reg-write-tmp-string
"GetDoubleString"
"XmlRootDir"
(ru-dirs-menu-xml)
) ;_ end of ru-reg-write-tmp-string
(ru-reg-write-tmp-string "GetDoubleString" "StartFromAcad" "1")
;;; Запуск диалога в цикле
(while continue
(ru-reg-write-tmp-string "GetDoubleString" "String1" (car result))
(ru-reg-write-tmp-string "GetDoubleString" "String2" (cadr result))
(ru-app-run command_line t)
(setq result (list
(ru-reg-read-tmp-string "GetDoubleString" "String1" "")
(ru-reg-read-tmp-string "GetDoubleString" "String2" "")
) ;_ end of list
reason (atoi
(ru-reg-read-tmp-string
"GetDoubleString"
"ResultDial"
"1"
) ;_ end of ru-reg-read-tmp-string
) ;_ end of ru-conv-str-to-bool
) ;_ end of setq
(cond
((= reason 3)
;;Выбор из Acad
(if (setq tmp_str
(ru-get-txt-from-dwg
(strcat "Выбери надпись из рисунка для " label1)
) ;_ end ofru-get-txt-from-dwg
) ;_ end of setq
(setq result (list tmp_str (cadr result)))
) ;_ end of if
)
((= reason 4)
;;Выбор из Acad
(if (setq tmp_str
(ru-get-txt-from-dwg
(strcat "Выбери надпись из рисунка для " label2)
) ;_ end ofru-get-txt-from-dwg
) ;_ end of setq
(setq result (list (car result) tmp_str))
) ;_ end of if
)
((= reason 1)
;;OK
(setq continue nil)
;; вернуть строку
)
(t
;; Отмена
(setq continue nil
result nil
) ;_ end of setq
)
) ;_ end of cond
) ;_ end of while
(ru-reg-delete-tmp-sub-key "GetDoubleString")
result
) ;_ end of defun
