求助这个代码怎么加DCL对话框。谢谢
<br/>(defun c:7( / pt l1 w1 px py ll)<br/> (setq pt (getpoint "\n请点选四方形的中心点<0,0>: "))<br/> (if (null pt)<br/> (setq pt '(0 0))<br/> )<br/> (princ pt)<br/> (if (null l)<br/> (setq l '100.0)<br/> )<br/> (princ "\n请输入四方形长度<")<br/> (princ l)<br/> (princ ">: ")<br/> (if (setq l1 (getdist))<br/> (setq l l1)<br/> )<br/> (setq px (polar pt '0 (* l 0.5)))<br/> (if (null w)<br/> (setq w '100.0)<br/> )<br/> (princ "\n请输入四方形宽度<")<br/> (princ w)<br/> (princ ">: ")<br/> (if (setq w1 (getdist))<br/> (setq w w1)<br/> )<br/> (setq py (polar pt (* pi 0.5) (* w 0.5)))<br/> (setq pt1 (polar px (* pi 1.5) (/ w 2)))<br/> (setq pt2 (polar py pi (/ l 2)))<br/> (setq old_osm (getvar "osmode"))<br/> (setvar "osmode" 0)<br/> (command "rectang" pt1 pt2) <br/> (setq ll l)<br/> (if (> l w)<br/> (setq ll w)<br/> )<br/> (if (null (tblsearch "layer" "center"))<br/> (command "layer" "n" "center" "c" "1" "center" "lt" "center" "center" "")<br/> )<br/> (command "line" (polar px '0 (* ll '0.05))<br/> (polar px pi (+ l (* ll '0.05))) "")<br/> (command "chprop" (entlast) "" "c" "1" "lt" "center" "la" "center" "")<br/> (command "line" (polar py (* pi '0.5) (* ll '0.05))<br/> (polar py (* pi '1.5) (+ w (* ll '0.05))) "")<br/> (command "chprop" (entlast) "" "c" "1" "lt" "center" "la" "center" "")<br/> (setvar "osmode" old_osm)<br/> (princ) <br/>) <br/> 本帖最后由 作者 于 2009-12-19 12:50:47 编辑(defun c:7 ( / pt l1 w1 px py ll)
(if (> (setq dcl_id(load_dialog "rct")) 0) (progn
(if (new_dialog "rct" dcl_id) (progn
(set_tile "my_l" "100.0")
(set_tile "my_w" "100.0")
(action_tile "accept" "(getdata)(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq re (start_dialog))
)
(alert "Unable to display dialog box!\n无法显示对话框！")
)
(unload_dialog dcl_id)
)
(alert "Unable to load dialog box!\n无法装载对话框！")
)
(if (= re 1) (progn
(setq pt (getpoint "\n请点选四方形的中心点<0,0>: "))
(if (null pt) (setq pt '(0 0)))
(princ pt)
; (if (null l) (setq l 100.0))
; (princ "\n请输入四方形长度<")
; (princ l)
; (princ ">: ")
; (if (setq l1 (getdist)) (setq l l1))
(setq px (polar pt 0 (* l 0.5)))
; (if (null w) (setq w 100.0))
; (princ "\n请输入四方形宽度<")
; (princ w)
; (princ ">: ")
; (if (setq w1 (getdist)) (setq w w1))
(setq py (polar pt (* pi 0.5) (* w 0.5)))
(setq pt1 (polar px (* pi 1.5) (/ w 2)))
(setq pt2 (polar py pi (/ l 2)))
(setq old_osm (getvar "osmode"))
(setvar "osmode" 0)
(command "rectang" pt1 pt2)
(setq ll l)
(if (> l w) (setq ll w))
(if (null (tblsearch "layer" "center"))
(command "layer" "n" "center" "c" "1" "center" "lt" "center" "center" "")
)
(command "line" (polar px '0 (* ll '0.05))
(polar px pi (+ l (* ll '0.05))) "")
(command "chprop" (entlast) "" "c" "1" "lt" "center" "la" "center" "")
(command "line" (polar py (* pi '0.5) (* ll '0.05))
(polar py (* pi '1.5) (+ w (* ll '0.05))) "")
(command "chprop" (entlast) "" "c" "1" "lt" "center" "la" "center" "")
(setvar "osmode" old_osm)
))
(princ)
)
(defun getdata ()
(setq l (atof (get_tile "my_l")))
(setq w (atof (get_tile "my_w")))
)
rct:dialog{
label="四方形参数输入";
:edit_box{label="长度:";key="my_l";}
:edit_box{label="宽度:";key="my_w";}
ok_cancel;
}
<p>谢谢您的回复。</p><p>我在调试过程中发现一个问题</p><ol><li> (action_tile "accept" "(getdata)(done_dialog 1)") </li><li> (action_tile "cancel" "(done_dialog 0)")原代码</li></ol><p> (action_tile "ok" "(getdata)(done_dialog 1)")<br/> (action_tile "cancel" "(done_dialog 0)")好象要改成这样才能运行。</p><p>现在运行到25行 (setq px (polar pt 0 (* l 0.5)))的L付值有问题？可以在麻烦您回答一下吗？</p><p></p> 少了个函数<br/>(defun getdata ()<br/> (setq l (atof (get_tile "my_l")))<br/> (setq w (atof (get_tile "my_w")))<br/>)<br/> 将对话框与lisp合并到一起
(defun c:7 (/ pt l1 w1 px py ll)
(defun getdata ()
(if (and (/= (get_tile "my_l") "") (/= (get_tile "my_w") ""))
(progn (setq l (atof (get_tile "my_l"))
w (atof (get_tile "my_w"))
)
(done_dialog 1)
)
(alert "没有输入数据！")
)
)
(defun Show_dcl ()
(setq dcl_id (load_dialog (setq Dcl_File (creat_dlg)))) ;对话框加载
(vl-file-delete Dcl_File);加载后删除DCL文件
(new_dialog "rct" dcl_id)
(set_tile "my_l" "100.0")
(set_tile "my_w" "100.0")
(action_tile "accept" "(getdata)")
(action_tile "cancel" "(done_dialog 0)")
(start_dialog)
)
(if (= (Show_dcl) 1)
(progn
(setq pt (getpoint "\n请点选矩形的中心点<0,0>: "))
(if (null pt)
(setq pt '(0 0))
)
(princ pt)
(setq px (polar pt 0 (* l 0.5)))
(setq py (polar pt (* pi 0.5) (* w 0.5)))
(setq pt1 (polar px (* pi 1.5) (/ w 2)))
(setq pt2 (polar py pi (/ l 2)))
(setq old_osm (getvar "osmode"))
(setvar "osmode" 0)
(command "rectang" pt1 pt2)
(setq ll l)
(if (> l w)
(setq ll w)
)
(if (null (tblsearch "layer" "center"))
(command "layer" "n" "center""c""1"
"center""lt" "center""center"""
)
)
(command "line"
(polar px '0 (* ll '0.05))
(polar px pi (+ l (* ll '0.05)))
""
)
(command "chprop"
(entlast)
""
"c"
"1"
"lt"
"center"
"la"
"center"
""
)
(command "line"
(polar py (* pi '0.5) (* ll '0.05))
(polar py (* pi '1.5) (+ w (* ll '0.05)))
""
)
(command "chprop"
(entlast)
""
"c"
"1"
"lt"
"center"
"la"
"center"
""
)
(setvar "osmode" old_osm)
)
)
(unload_dialog dcl_id)
(princ)
)
(defun creat_dlg (/ Dcl_File file str)
(setq Dcl_File (vl-filename-mktemp nil nil ".Dcl")
file(open Dcl_File "w")
)
(foreach str '("rct:dialog{";
"label=\"四方形参数输入\";"
":edit_box{label=\"长度:\";key=\"my_l\";}"
":edit_box{label=\"宽度:\";key=\"my_w\";}"
"ok_cancel;"
"}"
)
(write-line str file)
)
(close file)
Dcl_File
)
万分感谢俩位的回答。两个多可以用！ 学习
页:
[1]