请求一个简单DCL对话框的lisp代码
本帖最后由 lizhu 于 2012-3-26 10:50 编辑挂了一个CAD外挂，但图标太多，想用一个image_button对话框集中调用一些功能，每个image_button对应外挂的一个命令。我是菜鸟，写不了lisp代码调用命令，恳请高手编一个。
已知DCL的fil1至fil6 对应 fil1_sld至fil6_sld，相对应的外挂命令是yx_yt、yx_roo、yx_dfx、yx_dad、yx_sg、yx_4mi。
外挂安装在d:\cad下
DCL对话框：
dcl_settings : default_dcl_settings{audit_level = 0;}
ima_but:image_button{width=16;aspect_ratio=0.6;color=152;}
fil:dialog{label="常用功能";
:row{
:ima_but{key="fil1";}
:ima_but{key="fil2";}
:ima_but{key="fil3";}
}
:row{
:ima_but{key="fil4";}
:ima_but{key="fil5";}
:ima_but{key="fil6";}
}
:row{fixed_width=true; alignment=centered;
cancel_button;
}
}
==============
本帖最后由 ZZXXQQ 于 2023-9-12 00:04 编辑
(defun c:tt ()
(if (> (setq dcl_id (load_dialog (findfile "fil.dcl"))) 0) (progn
(if (new_dialog "fil" dcl_id "") (progn
(showsld)
(action_tile "fil1" "(done_dialog 1)")
(action_tile "fil2" "(done_dialog 2)")
(action_tile "fil3" "(done_dialog 3)")
(action_tile "fil4" "(done_dialog 4)")
(action_tile "fil5" "(done_dialog 5)")
(action_tile "fil6" "(done_dialog 6)")
(action_tile "cancel" "(done_dialog 0)")
(setq re (start_dialog))
)
(princ "\n无法显示对话框！")
)
(unload_dialog dcl_id)
)
(princ "\n无法加载对话框！")
)
(cond
((= re 1) (load "d:/cad/yx_yt") (c:yx_yt))
((= re 2) (load "d:/cad/yx_roo") (c:yx_roo))
((= re 3) (load "d:/cad/yx_dfx") (c:yx_dfx))
((= re 4) (load "d:/cad/yx_dad") (c:yx_dad))
((= re 5) (load "d:/cad/yx_sg") (c:yx_sg))
((= re 6) (load "d:/cad/yx_4mi") (c:yx_4mi))
)
(princ)
)
;已知DCL的fil1至fil6 对应 fil1_sld至fil6_sld
(defun showsld ()
(setq sldname "fil" i 1)
(repeat 6
(setq sldnm (strcat sldname (itoa i))
x (dimx_tile sldnm)
y (dimy_tile sldnm))
(if (setq sld (findfile (strcat sldnm "_sld.sld"))) (progn
(start_image sldnm)
(fill_image 0 0 x y -2)
(slide_image 0 0 x y sld)
(end_image)
)
(set_tile sldnm (strcat sldnm "_sld.sld"))
)
(setq i (1+ i))
)
)
本帖最后由 lee50310 于 2022-8-2 18:45 编辑
提供一個完整的範例(含幻燈片) 可參考看看
檔案存放路徑 d槽 temp 目錄下
若放在其他地方 則需修改 程式中的 路徑(setq path "D:\\TEMP\\")
執行指令:tt2
效果如動態圖
感谢大大！
可是为什么我加载输入tt命令对话框一闪就不见了呢？？？
还有我需要加载sld幻灯片的代码，就是 fil1对 fil1_sld，fil2对 fil2_sld............. 找到问题了，老大的(defun sowsld ()漏了一个字母，应是(defun showsld ()。
可问题是点幻灯片调用不了外挂命令呀。 shousld函数重名了。所以只能有一个程序能正常执行。 lizhu 发表于 2011-12-17 14:28 static/image/common/back.gif
找到问题了，老大的(defun sowsld ()漏了一个字母，应是(defun showsld ()。
可问题是点幻灯片调用不了外挂 ...
为什么不显示名字？只有白色底子
(defun c:tt ()
(if (> (setq dcl_id (load_dialog (findfile "fil.dcl"))) 0) (progn
(if (new_dialog "fil" dcl_id "") (progn
(showsld)
(action_tile "画箭头" "(done_dialog 1)")
(action_tile "fil2" "(done_dialog 2)")
(action_tile "fil3" "(done_dialog 3)")
(action_tile "fil4" "(done_dialog 4)")
(action_tile "fil5" "(done_dialog 5)")
(action_tile "fil6" "(done_dialog 6)")
(action_tile "cancel" "(done_dialog 0)")
(setq re (start_dialog))
)
(princ "\n无法显示对话框！")
)
(unload_dialog dcl_id)
)
(princ "\n无法加载对话框！")
)
(cond
((= re 1) (load "D:/soft/工具/画箭头.lsp") (c:hjt))
((= re 2) (load "d:/cad/yx_roo") (c:yx_roo))
((= re 3) (load "d:/cad/yx_dfx") (c:yx_dfx))
((= re 4) (load "d:/cad/yx_dad") (c:yx_dad))
((= re 5) (load "d:/cad/yx_sg") (c:yx_sg))
((= re 6) (load "d:/cad/yx_4mi") (c:yx_4mi))
)
(princ)
)
;已知DCL的fil1至fil6 对应 fil1_sld至fil6_sld
(defun showsld ()
(setq sldname "fil" i 1)
(repeat 6
(setq sldnm (strcat sldname (itoa i))
x (dimx_tile sldnm)
y (dimy_tile sldnm))
(if (setq sld (findfile (strcat sldnm "_sld.sld"))) (progn
(start_image sldnm)
(fill_image 0 0 x y -2)
(slide_image 0 0 x y sld)
(end_image)
)
(set_tile sldnm (strcat sldnm "_sld.sld"))
)
(setq i (1+ i))
)
)
dcl_settings : default_dcl_settings{audit_level = 0;}
ima_but:image_button{width=8;aspect_ratio=0.6;color=255;}
fil:dialog{label="常用功能";
:row{
:boxed_column{
fixed_width=true;
label="图层类";
:ima_but{key="画箭头";}
:ima_but{key="fil2";}
:ima_but{key="fil3";}
}
}
:row{
:ima_but{key="fil4";}
:ima_but{key="fil5";}
:ima_but{key="fil6";}
}
:row{fixed_width=true; alignment=centered;
cancel_button;
}
}
ZZXXQQ 发表于 2011-12-17 09:09
这里就执行不了 shcvip 发表于 2023-9-11 22:17
这里就执行不了
(load_dialog (findfile "fil.dcl"))
程序停在这里了。
页:
[1]
2