求助论坛老师帮完善这个简单的程序!
新手求助!求助论坛老师帮完善这个简单的程序,谢谢!
(defun c:test()
;;添加完善此程序
(princ)
)
(defun make-dcl(/ lst_str str file f)
(setq lst_str '(
"temp:dialog"
"{label=\"对话框测试\" ;"
" :boxed_column { label = \"test\" ;"
" :column {"
" :row {"
" :button { key = \"t1\" ;label = \"test1\" ;width = 15 ; }" ;; 想让此按钮打开系统计算器，此对话框不退出
" :button { key = \"t2\" ;label = \"test2\" ;width = 15 ; }}";; 想让此按钮CAD命令“line”,执行后退出此对话框
" :column {"
" :row {"
" :button { key = \"t3\" ;label = \"test3\" ;width = 15 ; }" ;; 想让此按钮调用自定命令“tt”，执行后退出此对话框
" :button { key = \"t4\" ;label = \"test4\" ;width = 15 ; }}}}}";;想让此按钮打开网站"bbs.mjtd.com"，此对话框不退出
"ok_cancel;"
"}"
)
)
(setq file (vl-filename-mktemp "temp3.dcl"))
(setq f (open file "w"))
(foreach str lst_str
(princ "\n" f)
(princ str f)
)
(close f)
;;返回
file
)
有好心人帮助一下么? 本帖最后由 ZZXXQQ 于 2014-10-21 12:55 编辑
(defun c:test()
(make-dcl)
(if (> (setq dcl_id (load_dialog "temp3")) 0) (progn
(setq re 2)
(while (or (= re 2) (= re 5))
(if (new_dialog "temp" dcl_id) (progn
(action_tile "t1" "(done_dialog 2)")
(action_tile "t2" "(done_dialog 3)")
(action_tile "t3" "(done_dialog 4)")
(action_tile "t4" "(done_dialog 5)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq re (start_dialog))
) (princ "\n无法显示对话框！"))
(cond
((= re 2) (startapp "calc.exe"))
((= re 5) (startapp "iexplore.exe" "http://bbs.mjtd.com"))
)
)
(unload_dialog dcl_id)
) (princ "\n无法加载对话框！"))
(if (> re 1)
(cond
((= re 3)
(command "_.LINE")
(while (> (getvar "CMDACTIVE") 0) (command PAUSE))
)
((= re 4) (c:tt))
)
)
(princ)
)
(defun make-dcl (/ lst_str str file f)
(setq lst_str
'(
"temp:dialog{"
" label=\"对话框测试\";"
" :boxed_column{"
"label=\"test\";"
":row{"
" :button{key=\"t1\";label=\"test1\";width=15;}";;打开系统计算器，对话框不退出
" :button{key=\"t2\";label=\"test2\";width=15;}";;运行CAD命令“line”,执行后退出对话框
"}"
":row {"
" :button{key=\"t3\";label=\"test3\";width=15;}";;调用自定命令“tt”，执行后退出对话框
" :button{key=\"t4\";label=\"test4\";width=15;}";;打开网站"bbs.mjtd.com"，对话框不退出
"};"
" };"
" ok_cancel;"
"}"
)
)
(setq file (vl-filename-mktemp "temp3.dcl"))
(setq f (open file "w"))
(foreach str lst_str (write-line str f))
(close f)
)
ZZXXQQ 发表于 2014-10-20 21:21
谢谢超级版主，可是运行命令显示"无法加载对话框" 本帖最后由 lucas_3333 于 2014-10-21 17:00 编辑
ZZXXQQ 发表于 2014-10-20 21:21 static/image/common/back.gif
参考Z版程序,东拼西凑了一个, 4个按钮都能打开对应的功能, 只是点击按钮后执行相关功能时,对话框都退出了, 不知道怎么使对话框不退出
楼下改好了,见8楼! ZZXXQQ 发表于 2014-10-20 21:21 static/image/common/back.gif
谢谢超级版主, 可是对话框还是无法加载 lucas_3333 发表于 2014-10-21 00:28 static/image/common/back.gif
参考Z版程序,东拼西凑了一个, 4个按钮都能打开对应的功能, 只是点击按钮后执行相关功能时,对话框都退出了 ...
谢谢lucas_3333, 可以执行,就是对话框都退出了.还是要谢谢你的帮助! 本帖最后由 lucas_3333 于 2014-10-21 16:59 编辑
sibelle_hu 发表于 2014-10-21 14:50 static/image/common/back.gif
谢谢lucas_3333, 可以执行,就是对话框都退出了.还是要谢谢你的帮助!
哈哈,这次改好了,加个while , 试试吧
(defun c:test()
(dhk)
(princ)
)
(defun make-dcl(/ lst_str str file f)
(setq lst_str '(
"temp:dialog"
"{label=\"对话框测试\" ;"
" :boxed_column { label = \"test\" ;"
" :column {"
" :row {"
" :button { key = \"t1\" ;label = \"test1\" ;width = 15 ; }" ;; 想让此按钮打开系统计算器，此对话框不退出
" :button { key = \"t2\" ;label = \"test2\" ;width = 15 ; }}";; 想让此按钮CAD命令“line”,执行后退出此对话框
" :column {"
" :row {"
" :button { key = \"t3\" ;label = \"test3\" ;width = 15 ; }" ;; 想让此按钮调用自定命令“tt”，执行后退出此对话框
" :button { key = \"t4\" ;label = \"test4\" ;width = 15 ; }}}}}";;想让此按钮打开网站"bbs.mjtd.com"，此对话框不退出
"ok_cancel;"
"}"
)
)
(setq file (vl-filename-mktemp "temp3.dcl"))
(setq f (open file "w"))
(foreach str lst_str
(princ "\n" f)
(princ str f)
)
(close f)
;;返回
file
)
(defun dhk(/ Dialog_Return dcl_id )
(setq dcl_id (load_dialog (make-dcl)))
(setq Dialog_Return 2)
(while
(or (= Dialog_Return 2)(= Dialog_Return 5))
(new_dialog "temp" dcl_id)
(action_tile "t1" "(done_dialog 2)")
(action_tile "t2" "(done_dialog 3)")
(action_tile "t3" "(done_dialog 4)")
(action_tile "t4" "(done_dialog 5)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq Dialog_Return (start_dialog))
(cond
((= Dialog_Return 2) (startapp "calc"))
((= Dialog_Return 3) (command "Line"))
((= Dialog_Return 4) (c:tt))
((= Dialog_Return 5) (startapp "C:\\Program Files\\Internet Explorer\\iexplore.exe" "bbs.mjtd.com"))
)
)
(unload_dialog dcl_id)
)
;;倾斜的文字变水平
(defun c:tt (/ ent i ss)
(if (setq ss (ssget '((0 . "*TEXT"))))
(repeat (setq i (sslength ss))
(setq ent (entget (ssname ss (setq i (1- i))))
ent (subst(cons 50 0.0)(assoc 50 ent) ent )
)
(entmod (subst (cons 51 0.0) (assoc 51 ent) ent ))
)
)
(princ)
)
lucas_3333 发表于 2014-10-21 16:57 static/image/common/back.gif
哈哈,这次改好了,加个while , 试试吧
嗯,现在好了! 达到要求了,谢谢! lucas_3333 发表于 2014-10-21 16:57 static/image/common/back.gif
哈哈,这次改好了,加个while , 试试吧
这个WHILE 真是用得太神奇了
页:
[1]