请求一个简单DCL对话框的lisp代码

lizhu

挂了一个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

1. (defun c:tt ()
   
2. (if (> (setq dcl_id (load_dialog (findfile "fil.dcl"))) 0) (progn
   
3.   (if (new_dialog "fil" dcl_id "") (progn
   
4.    (showsld)
   
5.    (action_tile "fil1" "(done_dialog 1)")
   
6.    (action_tile "fil2" "(done_dialog 2)")
   
7.    (action_tile "fil3" "(done_dialog 3)")
   
8.    (action_tile "fil4" "(done_dialog 4)")
   
9.    (action_tile "fil5" "(done_dialog 5)")
   
10.    (action_tile "fil6" "(done_dialog 6)")
    
11.    (action_tile "cancel" "(done_dialog 0)")
    
12.    (setq re (start_dialog))
    
13.   )
    
14.    (princ "\n无法显示对话框！")
    
15.   )
    
16.   (unload_dialog dcl_id)
    
17. )
    
18.   (princ "\n无法加载对话框！")
    
19. )
    
20. (cond
    
21.   ((= re 1) (load "d:/cad/yx_yt") (c:yx_yt))
    
22.   ((= re 2) (load "d:/cad/yx_roo") (c:yx_roo))
    
23.   ((= re 3) (load "d:/cad/yx_dfx") (c:yx_dfx))
    
24.   ((= re 4) (load "d:/cad/yx_dad") (c:yx_dad))
    
25.   ((= re 5) (load "d:/cad/yx_sg") (c:yx_sg))
    
26.   ((= re 6) (load "d:/cad/yx_4mi") (c:yx_4mi))
    
27. )
    
28. (princ)
    
29. )
    
30. ;已知DCL的fil1至fil6 对应 fil1_sld至fil6_sld
    
31. (defun showsld ()
    
32. (setq sldname "fil" i 1)
    
33. (repeat 6
    
34.   (setq sldnm (strcat sldname (itoa i))
    
35.         x (dimx_tile sldnm)
    
36.         y (dimy_tile sldnm))
    
37.   (if (setq sld (findfile (strcat sldnm "_sld.sld"))) (progn
    
38.    (start_image sldnm)
    
39.    (fill_image 0 0 x y -2)
    
40.    (slide_image 0 0 x y sld)
    
41.    (end_image)
    
42.   )
    
43.    (set_tile sldnm (strcat sldnm "_sld.sld"))
    
44.   )
    
45.   (setq i (1+ i))
    
46. )
    
47. )
    

(defun c:tt ()<br /> (if (> (setq dcl_id (load_dialog (findfile "fil.dcl"))) 0) (progn<br />   (if (new_dialog "fil" dcl_id "") (progn<br />    (showsld)<br />    (action_tile "fil1" "(done_dialog 1)")<br />    (action_tile "fil2" "(done_dialog 2)")<br />    (action_tile "fil3" "(done_dialog 3)")<br />    (action_tile "fil4" "(done_dialog 4)")<br />    (action_tile "fil5" "(done_dialog 5)")<br />    (action_tile "fil6" "(done_dialog 6)")<br />    (action_tile "cancel" "(done_dialog 0)")<br />    (setq re (start_dialog))<br />   )<br />    (princ "\n无法显示对话框！")<br />   )<br />   (unload_dialog dcl_id)<br /> )<br />   (princ "\n无法加载对话框！")<br /> )<br /> (cond<br />   ((= re 1) (load "d:/cad/yx_yt") (c:yx_yt))<br />   ((= re 2) (load "d:/cad/yx_roo") (c:yx_roo))<br />   ((= re 3) (load "d:/cad/yx_dfx") (c:yx_dfx))<br />   ((= re 4) (load "d:/cad/yx_dad") (c:yx_dad))<br />   ((= re 5) (load "d:/cad/yx_sg") (c:yx_sg))<br />   ((= re 6) (load "d:/cad/yx_4mi") (c:yx_4mi))<br /> )<br /> (princ)<br /> )<br /> ;已知DCL的fil1至fil6 对应 fil1_sld至fil6_sld<br /> (defun showsld ()<br /> (setq sldname "fil" i 1)<br /> (repeat 6<br />   (setq sldnm (strcat sldname (itoa i))<br />         x (dimx_tile sldnm)<br />         y (dimy_tile sldnm))<br />   (if (setq sld (findfile (strcat sldnm "_sld.sld"))) (progn<br />    (start_image sldnm)<br />    (fill_image 0 0 x y -2)<br />    (slide_image 0 0 x y sld)<br />    (end_image)<br />   )<br />    (set_tile sldnm (strcat sldnm "_sld.sld"))<br />   )<br />   (setq i (1+ i))<br /> )<br /> )<br />

lizhu

感谢大大！
可是为什么我加载输入tt命令对话框一闪就不见了呢？？？
还有我需要加载sld幻灯片的代码，就是 fil1对 fil1_sld，fil2对 fil2_sld.............

lizhu

找到问题了，老大的(defun sowsld ()漏了一个字母，应是(defun showsld ()。
可问题是点幻灯片调用不了外挂命令呀。

ZZXXQQ

shousld函数重名了。所以只能有一个程序能正常执行。

长风（尚品）

lizhu 发表于 2011-12-17 14:28
找到问题了，老大的(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;
}
}

lee50310

提供一個完整的範例(含幻燈片) 可參考看看

檔案存放路徑 d槽 temp 目錄下
若放在其他地方 則需修改 程式中的 路徑  (setq path "D:\\TEMP\\")
執行指令:tt2

效果如動態圖

shcvip

ZZXXQQ 发表于 2011-12-17 09:09

这里就执行不了

shcvip

shcvip 发表于 2023-9-11 22:17
这里就执行不了

(load_dialog (findfile "fil.dcl"))
程序停在这里了。

xyp1964