菜鸟问个lisp/DCL的问题
本帖最后由 福建师大附中 于 2016-2-13 00:31 编辑mjbz:dialog{
label="面积标注插件";
:text{
label="zhw--12测绘";
alignment=centered; //向中对齐
}
:boxed_row{
label="字体高度设定";
fixed_width=true;
alignment=centered;
:edit_box{ //编辑框对象
label="字高"; //编辑框卷标
key="txtzg";
edit_width=10; //编辑框高度
}
:popup_list{
key="popzg";
edit_width=10;
}
}
:boxed_row{
label="小数点设定";
fixed_width=true;
alignment=centered;
:edit_box{ //编辑框对象
label="小数点"; //编辑框卷标
key="txtxsd";
edit_width=10; //编辑框高度
}
:popup_list{
key="popxsd";
edit_width=10;
}
}
:boxed_row{
label="标注单位";
:button{
label="平方米标注";
key="pfmbz";
}
:button{
label="亩标注";
key="mbz";
}
:button{
label="公顷标注";
key="gqbz";
}
}
spacer_1; //空白一行
ok_cancel;
}(defun c:mjbz()
(setvar "cmdecho" 0)
(setq popzg_list '("1" "2" "3" "4" "5" "8" "10" "12" "15" "20" "30"))
(chk_style)
(dcl_mjbz)
(prin1)
)
(defun dcl_mjbz()
(setq dcl_id (load_dialog "f:\\a\\chugao.dcl"))
(new_dialog "mjbz" dcl_id)
(show_list "popzg" popzg_list) ;显示字高下拉框
(set_tile "txtzg" "1") ;预设字高文字框显示为“1”
(action_tile "popzg" "(sub_popzg $value)") ;触发DCL对象，并执行其后指定动作，同时产生六个变量
(action_tile "pfmbz" "(sub_pfmbz)(done_dialog 2)")
(action_tile "mbz" "(sub_mbz)(done_dialog 3)")
(action_tile "gqbz" "(sub_gqbz)(done_dialog 4)")
(setq dd(start_dialog)) ;将控制权交给DCL
(cond
((= dd 2)
(setq pt (getpoint"\请点取计算面积书写位置：" ))
(SETQ STA (BPOLY PT))
(IF (= STA NIL) (EXIT)) ;因autocad的原因，有可能找不到边界
(COMMAND "AREA" "E" "L")
(SETQ QAREA (rtos (GETVAR "AREA") 2 3)) ;最后面的数字2是十进制，3是控制标注的小数点位数
(command "layer" "m" "面积" "c" "" "" "")
(COMMAND "TEXT" PT txtzg "0" (strcat QAREA "平方米"));1字体大小，0角度
)
((= dd 3)
(setq pt (getpoint"\请点取计算面积书写位置：" ))
(SETQ STA (BPOLY PT))
(IF (= STA NIL) (EXIT)) ;因autocad的原因，有可能找不到边界
(COMMAND "AREA" "E" "L")
(SETQ QAREA (rtos (* (/ (GETVAR "AREA") 10000) 15) 2 3)) ;最后面的数字2是十进制，3是控制标注的小数点位数
(command "layer" "m" "面积" "c" "" "" "")
(COMMAND "TEXT" PT txtzg "0" (strcat QAREA "亩"));1字体大小，0角度
)
((= dd 4)
(setq pt (getpoint"\请点取计算面积书写位置：" ))
(SETQ STA (BPOLY PT))
(IF (= STA NIL) (EXIT)) ;因autocad的原因，有可能找不到边界
(COMMAND "AREA" "E" "L")
(SETQ QAREA (rtos (/ (GETVAR "AREA") 10000) 2 3)) ;最后面的数字2是十进制，3是控制标注的小数点位数
(command "layer" "m" "面积" "c" "" "" "")
(COMMAND "TEXT" PT txtzg "0" (strcat QAREA "公顷"));1字体大小，0角度
)
)
)
(defun show_list(key newlist) ;调用显示选单数据子程序
(start_list key) ;;;;;;;;;开始处理选单对象
(mapcar 'add_list newlist) ;逐一加入信息至选单
(end_list) ;结束处理选单
)
(defun sub_popzg(vvs)
(set_tile "txtzg" (nth (atoi vvs) popzg_list)) ;设定字高编辑框
)
(defun sub_pfmbz()
(setq txtzg (get_tile "txtzg"))
(setq txtxsd (get_tile "txtxsd"))
)
(defun sub_mbz()
(setq txtzg (get_tile "txtzg"))
(setq txtxsd (get_tile "txtxsd"))
)
(defun sub_gqbz()
(setq txtzg (get_tile "txtzg"))
(setq txtxsd (get_tile "txtxsd"))
)
(defun chk_style() ;检查字型
(setq chksty (tblsearch "style" "Standard"))
(if (null chksty) ;如果不存在，则新建字形
(command "_style" "Standard" "宋体" "" "" "" "" "")
)
(setq chklay (tblsearch "layer" "面积")) ;检测图层是否存在
(if (null chklay) ;如果不存在，则新建图层
(command "_layer" "m" "面积" "c" "3" "面积" "")
)
(setvar "clayer" "面积") ;预设目前图层
(setvar "textstyle" "Standard") ;预设目前字形
)
想要插入一段能够改变面积的小数点位数的编码（如0.0,0.00,0.000,0.0000），应该要怎么写http://bbs.mjtd.com/data/attachment/album/201602/13/002918kz24a22a2xmuju92.jpg
mjbz:dialog{
label="面积标注插件";
alignment=centered; //向中对齐
:text{label="zhw--12测绘";}
:popup_list{label="字高";key="popzg";edit_width=10;}
:popup_list{label="小数点";key="popxsd";edit_width=10;}
:radio_row{
label="标注单位";
key="bzdw";
:radio_button{label="平方米";key="pfmbz";value=1;}
:radio_button{label="亩";key="mbz";value=0;}
:radio_button{label="公顷";key="gqbz";value=0;}
}
spacer_1; //空白一行
ok_cancel;
}
(defun c:mjbz()
(setvar "cmdecho" 0)
(setq popzg_list '("1" "2" "3" "4" "5" "8" "10" "12" "15" "20" "30"))
(setq popxsd_list '("0.0" "0.00" "0.000" "0.0000" "0.00000" "0.000000" "0.0000000"))
(chk_style)
(dcl_mjbz)
(prin1)
)
(defun readata ()
(setq bzdw (get_tile "bzdw"))
(setq bl (cond((= bzdw "pfmbz") 1)((= bzdw "mbz") (/ 10000 15.0))((= bzdw "gqbz") 10000)))
(setq bzdw (cond((= bzdw "pfmbz") "平方米")((= bzdw "mbz") "亩")((= bzdw "gqbz") "公顷")))
(setq txtzg (itoa (nth (itoa (get_tile "popzg")) popzg_list)))
(setq xsd (1+ (itoa (get_tile "popxsd"))))
)
(defun dcl_mjbz()
(if (> (setq dcl_id (load_dialog "mjbz.dcl")) 0) (progn
(if (new_dialog "mjbz" dcl_id) (progn
(show_lst "popzg" popzg_list)
(set_tile "popzg" "0")
(show_lst "popxsd" popxsd_list)
(set_tile "popxsd" "2")
(action_tile "cancel" "(done_dialog 0)")
(action_tile "accept" "(readata)(done_dialog 1)")
(setq dd(start_dialog)) ;将控制权交给DCL
)
(princ "\n无法显示对话框！")
)
(unload_dialog dcl_id)
)
(princ "\n无法加载对话框！")
)
(if (= dd 1) (progn
(setq pt (getpoint "\请点取计算面积书写位置：" ))
(if (setq STA (bpoly PT)) (progn
(command "AREA" "E" "L")
(setq QAREA (rtos (/ (getvar "AREA") bl) 2 xsd)) ;2 = 十进制，xsd = 小数点位数
(command "TEXT" PT txtzg "0" (strcat QAREA bzdw));txtzg=字高，0角度
))
))
)
(defun show_list(key newlist) ;调用显示选单数据子程序
(start_list key) ;开始处理选单对象
(mapcar 'add_list newlist) ;逐一加入信息至选单
(end_list) ;结束处理选单
)
(defun chk_style() ;检查字型
(setq chksty (tblsearch "style" "Standard"))
(if (null chksty) ;如果不存在，则新建字形
(command "_style" "Standard" "宋体" "" "" "" "" "")
)
(command "_layer" "m" "面积" "c" "3" "" "")
(setvar "clayer" "面积") ;预设目前图层
(setvar "textstyle" "Standard") ;预设目前字形
)
本帖最后由 kewyst 于 2016-2-13 13:41 编辑
很不错啊，看见大神的回复，正在学习dcl，能把dcl打包到lsp里面吗？
(setq txtzg (itoa (nth (itoa (get_tile "popzg")) popzg_list))) 这句有问题！
(defun show_list(key newlist) (show_lst "popzg" popzg_list) 也有问题 本帖最后由 feng83 于 2016-3-24 20:43 编辑
(defun c:mjbz()
(setvar "cmdecho" 0)
(setq popzg_list '("1" "2" "3" "4" "5" "8" "10" "12" "15" "20" "30"))
(setq popxsd_list '("0.0" "0.00" "0.000" "0.0000" "0.00000" "0.000000" "0.0000000"))
(chk_style)
(dcl_mjbz)
(prin1)
)
(defun readata ()
(setq bzdw (get_tile "bzdw"))
(setq bl (cond((= bzdw "pfmbz") 1)
((= bzdw "mbz") (/ 10000 15.0))
((= bzdw "gqbz") 10000)))
(setq bzdw (cond((= bzdw "pfmbz") "平方米")
((= bzdw "mbz") "亩")
((= bzdw "gqbz") "公顷")))
(setq txtzg (nth (atoi (get_tile "popzg")) popzg_list))
(setq xsd (1+ (atoi (get_tile "popxsd"))))
)
(defun dcl_mjbz()
(if (> (setq dcl_id (load_dialog "c:/mjbz.dcl")) 0)
(progn
(if (new_dialog "mjbz" dcl_id)
(progn
(show_list "popzg" popzg_list)
(set_tile "popzg" "0")
(show_list "popxsd" popxsd_list)
(set_tile "popxsd" "2")
(action_tile "cancel" "(done_dialog 0)")
(action_tile "accept" "(readata)(done_dialog 1)")
(setq dd(start_dialog)) ;将控制权交给DCL
)
(princ "\n无法显示对话框！")
)
(unload_dialog dcl_id)
)
(princ "\n无法加载对话框！")
)
(if (= dd 1)
(progn
(setq pt (getpoint "\请点取计算面积书写位置：" ))
(if (setq STA (bpoly PT))
(progn
(command "AREA" "E" "L")
(setq QAREA (rtos (/ (getvar "AREA") bl) 2 xsd)) ;2 = 十进制，xsd = 小数点位数
(command "TEXT" PT txtzg "0" (strcat QAREA bzdw));txtzg=字高，0角度
))
))
)
(defun show_list(key newlist) ;调用显示选单数据子程序
(start_list key) ;开始处理选单对象
(mapcar 'add_list newlist) ;逐一加入信息至选单
(end_list) ;结束处理选单
)
(defun chk_style() ;检查字型
(setq chksty (tblsearch "style" "Standard"))
(if (null chksty) ;如果不存在，则新建字形
(command "_style" "Standard" "宋体" "" "" "" "" "")
)
(command "_layer" "m" "面积" "c" "3" "" "")
(setvar "clayer" "面积") ;预设目前图层
(setvar "textstyle" "Standard") ;预设目前字形
)
只是改了几处错误，让程序可以运行
页:
[1]