帮忙编写一个dcl对话框面积计算的lisp程序
mjbz:dialog{label="面积标注";
:boxed_radio_row{
label="转换单位";
:radio_button{
label="平方米";
key="mm";
}
:radio_button{
label="亩";
key="mu";
value="1"; //预设选项
}
}
:boxed_row{
label="标注方式";
:button{
label="单一标注";
key="dybz";
}
:button{
label="批量标注";
key="plbz";
}
}
spacer_1; //空白一行
ok_cancel;
}http://bbs.mjtd.com/data/attachment/album/201602/05/115452eorynrqnprzuorqs.jpg希望最后提供源码，想要学习一下
mjbz:dialog{
label="面积标注";
:boxed_radio_row{
label="转换单位";
key="zhdw";
:radio_button{label="平方米";key="mm";}
:radio_button{label="亩";key="mu";value="1";} //预设选项
}
:boxed_row{
label="标注方式";
:button{label="单一标注";key="dybz";}
:button{label="批量标注";key="plbz";}
}
spacer_1; //空白一行
ok_cancel;
}(defun c:mjbz ()
(setvar "CMDECHO" 0)
(setq re 2)
(if (> (setq dcl_id (load_dialog "mjbz.dcl")) 0) (progn
(while (> re 1)
(if (new_dialog "mjbz" dcl_id) (progn
(action_tile "dybz" "(getdata)(done_dialog 2)")
(action_tile "plbz" "(getdata)(done_dialog 3)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq re (start_dialog))
)
(princ "\n无法显示对话框！")
)
(cond
((= re 2)
(if (setq pt (getpoint "\n区域内一点: ")) (progn
(command "bondory" pt "")
(command "area" "e" "l" "" "ERASE" "L" "")
(setq mj (strcat (rtos (/ (getvar "AREA") x) 2 3) " " zhdw))
(command "TEXT" pt "" "" 0 mj)
))
)
((= re 3)
(while (setq pt (getpoint "\n区域内一点: "))
(command "bondory" pt "")
(command "area" "e" "l" "" "ERASE" "L" "")
(setq mj (strcat (rtos (/ (getvar "AREA") x) 2 3) " " zhdw))
(command "TEXT" pt "" "" 0 mj)
)
)
)
)
(unload_dialog dcl_id)
)
(princ "\n无法加载对话框！")
)
(princ)
)
(defun getdata ()
(setq x (if (= (get_tile "zhdw") "mm") 1 666666.667));2000000/3
)
ZZXXQQ 发表于 2016-2-6 08:09 static/image/common/back.gif
命令: mjbz
区域内一点: 未知命令“MJBZ”。按 F1 查看帮助。
; 错误: 参数类型错误: stringp nil
加载之后会出现这个错误是怎么回事 不错的资料， 谢谢分享啊。 试试，谢谢分享！！！！ 有问题，~~~~~~~~~~~
试试，谢谢分享！！！！ 本帖最后由 song宋_74729 于 2022-8-13 08:52 编辑
===================================================
(setq dcl_file (open (setq tmp-dcl-file-name (vl-filename-mktemp nil nil".DCL")) "w"))
(progn
(foreach x
'(
"mjbz:dialog{"
" label=\"面积标注\";"
" :boxed_radio_row{"
" label=\"转换单位\";"
" :radio_button{"
" label=\"平方米\";"
" key=\"mm\";"
" }"
" :radio_button{"
" label=\"亩\";"
" key=\"mu\";"
" value=\"1\"; //默认选项"
" }"
" }"
" "
" :boxed_row{"
" label=\"标注方式\";"
" :button{"
" label=\"单一标注\";"
" key=\"dybz\";"
" }"
" :button{"
" label=\"批量标注\";"
" key=\"plbz\";"
" }"
" }"
" spacer_1; //空白一行"
" ok_cancel;"
" }"
) (write-line x dcl_file) )
(setq dcl_file (close dcl_file)))
(defun c:mjbz ()
(setvar "CMDECHO" 0)
(setq re 2)
(if (> (setq dcl_id (load_dialog tmp-dcl-file-name)) 0) (progn
(while (> re 1)
(if (new_dialog "mjbz" dcl_id) (progn
(action_tile "dybz" "(getdata)(done_dialog 2)")
(action_tile "plbz" "(getdata)(done_dialog 3)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq re (start_dialog))
)
(princ "\n无法显示对话框！")
)
(cond
((= re 2)
(if (setq pt (getpoint "\n区域内一点: ")) (progn
(command "bondory" pt "")
(command "area" "e" "l" "" "ERASE" "L" "")
(setq mj (strcat (rtos (/ (getvar "AREA") x) 2 3) " " zhdw))
(command "TEXT" pt "" "" 0 mj)
))
)
((= re 3)
(while (setq pt (getpoint "\n区域内一点: "))
(command "bondory" pt "")
(command "area" "e" "l" "" "ERASE" "L" "")
(setq mj (strcat (rtos (/ (getvar "AREA") x) 2 3) " " zhdw))
(command "TEXT" pt "" "" 0 mj)
)
)
)
)
(unload_dialog dcl_id)
)
(princ "\n无法加载对话框！")
)
(princ)
)
(defun getdata ()
(setq x (if (= (get_tile "zhdw") "mm") 1 666666.667));2000000/3
)
不错，学习、学习 本帖最后由 xj6019 于 2022-9-5 19:06 编辑
源码大佬已经给你很多了，换种新玩法
需要两个文件同时加载，才有效，一种高效便捷的dcl玩法，嘿嘿嘿！！！！！！
摘自附件文件内的对话框部分的代码，如下：
(defun C:NM (/ acttlst dclcidian key2str lst_str)
(setq dclcidian "mianji-cidian")
(setq lst_str
(append(dcl-name "面积标注" )
(dcl-vh '("BH" "转换单位"))
(dcl-dan '(("平方米" "PINGFANG" "5") ("亩" "MU" "5")) "")
(dcl-vh "e")
(dcl-vh '("BH" "标注方式"))
(dcl-an'(("单一标注" "DANYI" "8" "2")("批量标注" "PILIANG" "8" "2"))"")
(dcl-vh "e")
(dcl-oc) ;确认按钮
)
)
(setq key2str(val2str '(1 0 0 0)))
(setq acttlst '(("DANYI" "3" "(dcl-DANYI)")("PILIANG" "4" "(dcl-PILIANG)")))
(xj-dcl-kdclcidianlst_strkey2str nil acttlst)
(princ)
)
页:
[1]