换填

 codebegin@

(defun c:HT2(/ Write_Dcl_Form1 Get_Form1_Data
Action_Form1_Keys settitle gettitle
getelev jisuan dcl_id Dcl_File
Dialog_Return keys elev1
elev2 loads cars peo
plant rong pao tao
tu mianceng huantian pick
result dcl_id Dcl_File
)
(defun Write_Dcl_Form1 (/ Dcl_File file str)
(setq Dcl_File (vl-filename-mktemp nil nil ".Dcl"))
(setq file (open Dcl_File "w"))
(foreach str '("edit_part : edit_box"
"{"

" edit_width = 8;"
" aligment = \"right\"; "
"}"
"Form1:dialog"
"{"
" label = \"JIN-换填计算器，请勿用于商业用途\";"
" :column"
" {"
" : boxed_column"
" {"
" label = \"标高参数 :\" ;"
" :row"
" {"
" : column"
" {"
" : edit_part "
" {"
" key = \"elev1\";"
" label = \"标高一:\";"
" }"
" : edit_part "
" {"
" key = \"elev2\";"
" label = \"标高二:\";"
" }"
" }"
" : column"
" {"
" : button "
" {"
" key = \"pickele2\";"
" label = \"选取标高一 F\";"
" width = 3;"
" height =1;"
" mnemonic = \"F\";"
" }"
" : button "
" {"
" key = \"pickele1\";"
" label = \"选取标高二 S\";"
" width = 3;"
" height =1;"
" mnemonic = \"S\";"
" }"
" }"
" }"
" }"

" : boxed_column"
" {"
" label = \"荷载参数:\" ;"
" :row"
" {"

" : column"
" {"
" : edit_part "
" {"
" key = \"loads\";"
" label = \"楼板容载:\";"
" }"

" :text "
" {"
" label = \"<=3 时按覆土深度(m)\";"
" }"
" :text "
" {"
" label = \">3 时按覆土容载(kN/m3)\";"
" }"

" :text "
" {"
" label = \"\";"
" }"

" }"

" : boxed_radio_column"
" {"
" key = \"mianceng\" ;"
" label = \"面层荷载(kN/m3)\";"
" : radio_button"
" {"
" key = \"car\" ;"
" label = \"车行道(10.3)\" ;"
" mnemonic = \"C\" ;"
" }"
" : radio_button"
" {"
" key = \"peo\";"
" label = \"人行道(6.5)\";"
" mnemonic = \"C\";"
" }"
" : radio_button "
" {"
" key = \"plant\";"
" label = \"草坪区(0)\";"
" mnemonic = \"C\";"
" }"
" }"
" }"
" }"
" : boxed_column"
" {"
" label = \"换填参数(KN/M3):\" ;"
" :row"
" {"
" : edit_part "
" {"
" key = \"rong\";"
" label = \"换填自重: \";"
" }"
" : boxed_radio_column"
" {"
" key = \"huantian\" ;"
" label = \"换填材料\";"

" : radio_button"
" {"
" key = \"ban\" ;"
" label = \"泡沫板(0.5)\" ;"
" mnemonic = \"T\" ;"
" }"
" : radio_button"
" {"
" key = \"pao\" ;"
" label = \"泡沫混凝土(5.5)\" ;"
" mnemonic = \"T\" ;"
" }"
" : radio_button"
" {"
" key = \"tao\";"
" label = \"陶粒(8)\";"
" mnemonic = \"T\";"
" }"
" : radio_button "
" {"
" key = \"tu\";"
" label = \"轻质土(12)\";"
" mnemonic = \"T\";"
" }"

" }"
" }"
" }"
" : boxed_row"
" {"
" label = \"计算结果(按18KN/M3种植土计算)  :\" ;"
" : row"
" {"

" : button "
" {"
" key = \"count\";"
" label = \"计算 C\";"
" width = 3;"
" height =1;"
" mnemonic = \"C\";"
" }"

" : text"
" {"
" key = \"result\";"
" label = \"需换填所选材料深度(m):\" ;"
" }"
" }"
" }"
" }"
"ok_cancel ;"
"}"
)
(write-line str file)
)
(close file)
Dcl_File
)
(defun Action_Form1_Keys (key value)
(cond
((= key "accept")
(done_dialog 1)
)
((= key "cancel")
(done_dialog 0)
)
((= key "pickele1")
(done_dialog 2)
(setq pick 1)
)
((= key "pickele2")
(done_dialog 2)
(setq pick 2)
)
((= key "elev1")
(setq elev1 (get_tile "elev1"))
)
((= key "elev2")
(setq elev2 (get_tile "elev2"))
)
((= key "loads")
(setq loads (get_tile "loads"))
)
((= key "rong")
(setq rong (get_tile "rong"))
(set_tile "huantian" "1")
)
((= key "mianceng")
(setq mianceng (get_tile "mianceng"))
)
((= key "huantian")
(setq huantian (get_tile "huantian"))
(set_tile "rong" "")
(setq rong "")
)
((= key "count") (jisuan))
)
(jisuan)
)
(defun gettitle ()
(setq elev1 (get_tile "elev1"))
(setq elev2 (get_tile "elev2"))
(setq loads (get_tile "loads"))
(setq rong (get_tile "rong"))
(setq mianceng (get_tile "mianceng"))
(setq huantian (get_tile "huantian"))
)
(defun getelev( / ss ent_elv1_Text ent_elv1_data)
(princ "\n请选择标高或等高线文字：")
(if (setq ss (ssget ":S:E" '((0 . "*TEXT*,TCH_ELEVATION"))))
(progn
(setq ent_elv1_Text (cdr (assoc 1 (entget (ssname ss 0)))))
(setq ent_elv1_data (vl-string-left-trim "$||0$FL/FL/BL/WL/TW/TS/TP/TPL/SL/TS/TC/TS/BW" ent_elv1_Text))
(setq ent_elv1_data (vl-string-right-trim "\n " ent_elv1_data))
(setq ent_elv1_data (rtos (atof ent_elv1_data) 2 3))
)
)
)
(defun jisuan( / h h_mc hezai_mc hezai caozai)
(if (and elev1 elev2 loads huantian (/= elev1 "") (/= elev2 "") (/= loads ""))
(progn
(cond
((/= rong "") (setq text (strcat "换填荷载为（" rong "）材料深度：")) (setq zl (atof rong)))
((= huantian "pao") (setq text "换填泡沫混凝土深度：") (setq zl 5.5))
((= huantian "tao") (setq text "换填陶粒深度：") (setq zl 8.0))
((= huantian "tu") (setq text "换填轻质土深度：") (setq zl 12.0))
((= huantian "ban") (setq text "换填泡沫板深度：") (setq zl 0.5))
)
(if (<= (atof loads) 3.0)
(setq hhh (* (atof loads) 18.0))
(setq hhh (atof loads))
)
(setq h (abs (- (atof elev1) (atof elev2))))
(cond
((= mianceng "car") (setq h_mc 0.48 hezai_mc 10.3))
((= mianceng "peo") (setq h_mc 0.31 hezai_mc 6.5))
(t (setq h_mc 0 hezai_mc 0))
)
(setq hezai (+ (* (- h h_mc) 18.0) hezai_mc))
(setq caozai (- hezai hhh))
(if (> hezai hhh)
(progn
(setq result (/ (+ (- (- hhh hezai_mc) (* 18.0 h)) (* 18.0 h_mc)) (- zl 18.0)))
(setq result (strcat text " " (rtos result 2 3) " m"))
)
(setq result "未超载，无需换填")
)
(set_tile "result" result)
)
(cond
((= elev1 "") (set_tile "result" "请输入或选择 标高一"))
((= elev2 "") (set_tile "result" "请输入或选择 标高二"))
((= loads "") (set_tile "result" "请输入顶板荷载"))
)
)
)
(setq dcl_id (load_dialog (setq Dcl_File (Write_Dcl_Form1))))
(vl-file-delete Dcl_File)
(setq Dialog_Return 2)
(setq keys '("elev1" "elev2" "pickele2" "pickele1" "loads" "rong" "mianceng" "huantian"))

(while (> Dialog_Return 1)
(if (not (new_dialog "Form1" dcl_id "" (cond ( *screenpoint_HT* ) ( '(-1 -1) ))))
(exit)
)
(if (not elev1_bak) (setq elev1_bak "0"))
(if (not elev2_bak) (setq elev2_bak "1.2"))
(if (not loads_bak) (setq loads_bak "21.6"))
(if (not mianceng_bak) (setq mianceng_bak "plant"))
(if (not huantian_bak) (setq huantian_bak "ban"))
(foreach key keys
(if (eval (read (strcat key "_bak")))
(set_tile key (eval (read (strcat key "_bak"))))
)
(action_tile key "(Action_Form1_Keys $key $value)")
)
(gettitle)
(jisuan)
(action_tile "accept" "(setq *screenpoint_HT* (done_dialog 1))")
(setq Dialog_Return (start_dialog))
(if (= Dialog_Return 2)
(progn
(cond
((= pick 1)
(setq elev2_bak (getelev))
)
((= pick 2)
(setq elev1_bak (getelev))
)
)
(setq pick nil)
)
)
)
(unload_dialog dcl_id)
(if (and (= Dialog_Return 1)
result
)
(princ (strcat "\n" result))
)
(setq elev1_bak elev1 elev2_bak elev2 loads_bak loads rong_bak rong mianceng_bak mianceng huantian_bak huantian)
(princ)
)

@codeend