根据请求完善一个带DCL的代码[教学]

lucas3

1. (defun c:tt (/ strl fn )
   
2.   (setq  str            '("temp:dialog {"
   
3.                       "label = \"示例\" ;"
   
4.                       ": column {"
   
5.                       "  : row {"
   
6.                       "    : image_button { height = 6;   key = \"bott1\";}"
   
7.                       "    : image_button { height = 6;   key = \"bott2\";}"
   
8.                       "    : image_button { height = 6;   key = \"bott3\";}"
   
9.                       "    }"
   
10.                       "  : boxed_row {"
    
11.                       "    label = \"操作\";"
    
12.                       "    ok_cancel;"
    
13.                       "    }"
    
14.                       "  errtile;"
    
15.                       "}"
    
16.                       "}"
    
17.                      )
    
18.         fn     (dcl:make strl)
    
19.   )
    
20.   (dcl:accept)
    
21.   (dcl:start id fn)
    
22.   (princ)
    
23. )
    

(defun c:tt (/ strl fn )<br />   (setq  str            '("temp:dialog {"<br />                       "label = \"示例\" ;"<br />                       ": column {"<br />                       "  : row {"<br />                       "    : image_button { height = 6;   key = \"bott1\";}"<br />                       "    : image_button { height = 6;   key = \"bott2\";}"<br />                       "    : image_button { height = 6;   key = \"bott3\";}"<br />                       "    }"<br />                       "  : boxed_row {"<br />                       "    label = \"操作\";"<br />                       "    ok_cancel;"<br />                       "    }"<br />                       "  errtile;"<br />                       "}"<br />                       "}"<br />                      )<br />         fn     (dcl:make strl)<br />   )<br />   (dcl:accept)<br />   (dcl:start id fn)<br />   (princ)<br /> )<br />

以上是Free-Lancer大师经典的代码，希望修改后完成以下功能：
image button对应的幻灯片分别的lib.slb 中的 001，002，003  sld

当选择第一个image button 后，按下确定则执行命令"line", 此时对话框关闭
当选择第一个image button 后，按下确定则执行命令"circle", 此时对话框关闭
当选择第一个image button 后，按下确定则执行命令"rectang", 此时对话框关闭

lib.slb已存于支持搜索路径下，需要一个完整的示例代码！加载就能运行，完成上述功能。


以上
谢谢！！！

Free-Lancer

lucas3 发表于 2014-10-5 16:20
谢谢Free-Lancer大师，示列中加了注释，很感谢！

程序还运行不了，对话框一闪而过，显示 错误: 参数 ...

有些函数还在调整中

1. (defun c:tt (/ strl fn do_what what_next kl dcl_id)
   
2.   (setq        strl          '("temp:dialog {"
   
3.                     "label = \"示例\" ;"
   
4.                     ": column {"
   
5.                     "  : row {"
   
6.                     "    : image_button { height = 6;   key = \"bott1\";}"
   
7.                     "    : image_button { height = 6;   key = \"bott2\";}"
   
8.                     "    : image_button { height = 6;   key = \"bott3\";}"
   
9.                     "    }"
   
10.                     "  : boxed_row {"
    
11.                     "    label = \"操作\";"
    
12.                     "    ok_cancel;"
    
13.                     "    }"
    
14.                     "  errtile;"
    
15.                     "}"
    
16.                     "}"
    
17.                    )
    
18.         fn          (dcl:make strl) ;_写出临时 DCL
    
19.         do_what          "bott1"
    
20.         what_next 2 ;_循环
    
21.         kl          '(("bott1" "lib(001)")
    
22.                     ("bott2" "lib(002)")
    
23.                     ("bott3" "lib(003)")
    
24.                    )
    
25.   )
    
26.   (while (= what_next 2) ;_done_dialog 后对话框就关闭了，
    
27.     (setq dcl_id (dcl:load fn "temp")) ;_加载对话框
    
28.     (dcl:imagebutton 'kl '(do_what)) ;_加载 sld
    
29.     (dcl:accept) ;_done_dialog ok = 1 , cancel = 0
    
30.     (setq what_next (dcl:init)) ;_显示对话框，控制权交给 DCL，do_what 为点击的 image_button $key, 对话框只记录三个状态 1 ok，0 cancel，临时关闭都是 2，谁关闭的 用 $key 记录
    
31.     (if        (= what_next 2)
    
32.       (cond ;_测试对话框返回值
    
33.         ((= do_what "bott1")
    
34.          (vl-cmdf ".line")
    
35.          (while        (/= (getvar "cmdactive") 0)
    
36.            (command pause)
    
37.          )
    
38.         )
    
39.         ((= "bott2" do_what)
    
40.          (command ".circle")
    
41.          (while        (/= (getvar "cmdactive") 0)
    
42.            (command pause)
    
43.          )
    
44.         )
    
45.         ((= "bott3" do_what);用 $key 判断作什么，不需要 done_dialog 状态，关就关了，知道是谁关的即可
    
46.          (command ".rectang")
    
47.          (while        (/= (getvar "cmdactive") 0)
    
48.            (command pause)
    
49.          )
    
50.         )
    
51.         (t)
    
52.       )
    
53.     )
    
54.   )
    
55.   (dcl:unload dcl_id fn) ;_卸载对话框
    
56.   (command)
    
57.   (princ)
    
58. )
    

(defun c:tt (/ strl fn do_what what_next kl dcl_id)<br />   (setq        strl          '("temp:dialog {"<br />                     "label = \"示例\" ;"<br />                     ": column {"<br />                     "  : row {"<br />                     "    : image_button { height = 6;   key = \"bott1\";}"<br />                     "    : image_button { height = 6;   key = \"bott2\";}"<br />                     "    : image_button { height = 6;   key = \"bott3\";}"<br />                     "    }"<br />                     "  : boxed_row {"<br />                     "    label = \"操作\";"<br />                     "    ok_cancel;"<br />                     "    }"<br />                     "  errtile;"<br />                     "}"<br />                     "}"<br />                    )<br />         fn          (dcl:make strl) ;_写出临时 DCL<br />         do_what          "bott1"<br />         what_next 2 ;_循环<br />         kl          '(("bott1" "lib(001)")<br />                     ("bott2" "lib(002)")<br />                     ("bott3" "lib(003)")<br />                    )<br />   )<br />   (while (= what_next 2) ;_done_dialog 后对话框就关闭了，<br />     (setq dcl_id (dcl:load fn "temp")) ;_加载对话框<br />     (dcl:imagebutton 'kl '(do_what)) ;_加载 sld <br />     (dcl:accept) ;_done_dialog ok = 1 , cancel = 0<br />     (setq what_next (dcl:init)) ;_显示对话框，控制权交给 DCL，do_what 为点击的 image_button $key, 对话框只记录三个状态 1 ok，0 cancel，临时关闭都是 2，谁关闭的 用 $key 记录<br />     (if        (= what_next 2)<br />       (cond ;_测试对话框返回值<br />         ((= do_what "bott1")<br />          (vl-cmdf ".line")<br />          (while        (/= (getvar "cmdactive") 0)<br />            (command pause)<br />          )<br />         )<br />         ((= "bott2" do_what)<br />          (command ".circle")<br />          (while        (/= (getvar "cmdactive") 0)<br />            (command pause)<br />          )<br />         )<br />         ((= "bott3" do_what);用 $key 判断作什么，不需要 done_dialog 状态，关就关了，知道是谁关的即可<br />          (command ".rectang")<br />          (while        (/= (getvar "cmdactive") 0)<br />            (command pause)<br />          )<br />         )<br />         (t)<br />       )<br />     )<br />   )<br />   (dcl:unload dcl_id fn) ;_卸载对话框<br />   (command)<br />   (princ)<br /> )<br />

DCL 文件写出、加载、load_dialog 及 start_dialog unload_dialog
(dcl:make strl) 写出临时DCL, 返回文件名
(dcl:load fname dname) 加载DCL， fname - dcl 文件名， dname - dialog name, 返回 load_dialog ID
(dcl:start dcl_id fn) 显示、卸载、删除临时文件, dcl_id - load_dialog 返回的 ID，fn - dcl 文件名
(dcl:init) 用于需要隐藏对话框时，(start_dialog)
(dcl:unload dcl_id fn) 卸载DCL、删除DCL

通用
(dcl:settile klst varlst) 批量设置或单个控件(key) 设置
(dcl:gettile klst)  批量获取或单个(key) 获取
(dcl:CtrlEnable klst) 批量启用控件或单个启用
(dcl:CtrlDisable klst) 批量禁用控件或单个禁用

ok cancel 定义
(Dcl:Accept) ok 和 cancel 定义， ok done_dialog = 1 , cancel  done_dialog = 0

errtile 控件
(dcl:ResError)   清空 errtile 控件显示
(dcl:SetError msg)   设置 errtile 控件提示文字

Image_button 控件
初始设置
(dcl:slidimage klst sldlst colst) 批量slideimage(需一一对应表参数)或单个控件 slideimage
(dcl:imagefillcolor klst colst) 批量imagefillcolor(需一一对应表参数)或单个控件 imagefillcolor
(DCL:ImageCrlDisable klst) 批量禁用 image 控件或禁用单个 image 控件
Action
(Dcl:ImageButton klst def) 批量slidimage 并设置默认，同时定义 action,
                           当 def 为表时关闭对话框 start_dialog 值为 2, def 设置为 $key

Button 控件
(dcl:buttonaction klst what) 批量定义button 控件动作，关闭对话框，start_dialog 值为 2 ,
                             what 为 $key

Toggle 控件
(DCL:ToggleAction klst deflst) 设置toggle 控件默认值及定义 action

List (pop_list list_box) 控件
(dcl:addlist klst varlst itemlst) 批量填表(需一一对应表参数)或单个控件填充列表
(dcl:listaction

Edit_box 控件
格式检查
(dcl:checkin input format kk) 检查输入格式
(dcl:checknumin klst)   数字box 检查输入
Action
(DCL:EditboxNumAction
(DCL:EditboxAction

Radio 控件组
(DCL:RadioInit klst deflst)
(Dcl:RadioAction
(Dcl:mRadioAction

Free-Lancer

没有调试，大体是这个意思

1. (defun c:tt (/ strl fn what_next dcl_id)
   
2.   (setq        str          '("temp:dialog {"
   
3.                     "label = \"示例\" ;"
   
4.                     ": column {"
   
5.                     "  : row {"
   
6.                     "    : image_button { height = 6;   key = \"bott1\";}"
   
7.                     "    : image_button { height = 6;   key = \"bott2\";}"
   
8.                     "    : image_button { height = 6;   key = \"bott3\";}"
   
9.                     "    }"
   
10.                     "  : boxed_row {"
    
11.                     "    label = \"操作\";"
    
12.                     "    ok_cancel;"
    
13.                     "    }"
    
14.                     "  errtile;"
    
15.                     "}"
    
16.                     "}"
    
17.                    )
    
18.         fn          (dcl:make strl) ;_写出临时 DCL
    
19.         what_next 2 ;_循环
    
20.   )
    
21.   (while (>= what_next 2) ;_done_dialog 后对话框就关闭了，
    
22.     ;;_所谓重新显示就是利用 DCL 的判断退出状态作一个循环
    
23.     ;;_不满足条件时重新加载、设置、显示 DCL
    
24.     (setq dcl_id (dcl:load fn "temp")) ;_加载对话框
    
25.     (mapcar '(lambda (x y)
    
26.                (DCL:SlideImage x y 0)
    
27.              )
    
28.             '("bott1" "bott2" "bott3")
    
29.             '("lib(001)" "lib(002)" "lib(003")
    
30.     ) ;_加载 sld
    
31.     (mapcar '(lambda (x y)
    
32.                (action_tile x (strcat "(done_dialog " y ")"))
    
33.              )
    
34.             '("bott1" "bott2" "bott3")
    
35.             '(3 4 5)
    
36.     ) ;_设置对应 action
    
37.     (dcl:accept) ;_done_dialog ok = 1 , cancel = 0
    
38.     (setq what_next (start_dialog)) ;_显示对话框，控制权交给 DCL
    
39.     (cond ;_测试对话框返回值
    
40.       ((= what_next 3)
    
41.        (vl-cmdf ".line")
    
42.        (while (/= (getvar "cmdactive") 0)
    
43.          (command pause)
    
44.        )
    
45.       )
    
46.       ((= what_next 4)
    
47.        (command ".circle")
    
48.        (while (/= (getvar "cmdactive") 0)
    
49.          (command pause)
    
50.        )
    
51.       )
    
52.       ((= what_next 5)
    
53.        (while (/= (getvar "cmdactive") 0)
    
54.          (command pause)
    
55.        )
    
56.       )
    
57.       (t)
    
58.     )
    
59.   )
    
60.   (unload_dialog dcl_id);_卸载对话框
    
61.   (vl-file-delete fn);_删除临时文件
    
62.   (princ)
    
63. )
    

(defun c:tt (/ strl fn what_next dcl_id)<br />   (setq        str          '("temp:dialog {"<br />                     "label = \"示例\" ;"<br />                     ": column {"<br />                     "  : row {"<br />                     "    : image_button { height = 6;   key = \"bott1\";}"<br />                     "    : image_button { height = 6;   key = \"bott2\";}"<br />                     "    : image_button { height = 6;   key = \"bott3\";}"<br />                     "    }"<br />                     "  : boxed_row {"<br />                     "    label = \"操作\";"<br />                     "    ok_cancel;"<br />                     "    }"<br />                     "  errtile;"<br />                     "}"<br />                     "}"<br />                    )<br />         fn          (dcl:make strl) ;_写出临时 DCL <br />         what_next 2 ;_循环<br />   )<br />   (while (>= what_next 2) ;_done_dialog 后对话框就关闭了，<br />     ;;_所谓重新显示就是利用 DCL 的判断退出状态作一个循环<br />     ;;_不满足条件时重新加载、设置、显示 DCL<br />     (setq dcl_id (dcl:load fn "temp")) ;_加载对话框<br />     (mapcar '(lambda (x y)<br />                (DCL:SlideImage x y 0)<br />              )<br />             '("bott1" "bott2" "bott3")<br />             '("lib(001)" "lib(002)" "lib(003")<br />     ) ;_加载 sld <br />     (mapcar '(lambda (x y)<br />                (action_tile x (strcat "(done_dialog " y ")"))<br />              )<br />             '("bott1" "bott2" "bott3")<br />             '(3 4 5)<br />     ) ;_设置对应 action<br />     (dcl:accept) ;_done_dialog ok = 1 , cancel = 0<br />     (setq what_next (start_dialog)) ;_显示对话框，控制权交给 DCL<br />     (cond ;_测试对话框返回值<br />       ((= what_next 3)<br />        (vl-cmdf ".line")<br />        (while (/= (getvar "cmdactive") 0)<br />          (command pause)<br />        )<br />       )<br />       ((= what_next 4)<br />        (command ".circle")<br />        (while (/= (getvar "cmdactive") 0)<br />          (command pause)<br />        )<br />       )<br />       ((= what_next 5)<br />        (while (/= (getvar "cmdactive") 0)<br />          (command pause)<br />        )<br />       )<br />       (t)<br />     )<br />   )<br />   (unload_dialog dcl_id);_卸载对话框<br />   (vl-file-delete fn);_删除临时文件<br />   (princ)<br /> )<br />

lucas3

Free-Lancer 发表于 2014-10-5 10:14
没有调试，大体是这个意思

谢谢Free-Lancer大师，示列中加了注释，很感谢！

程序还运行不了，对话框一闪而过，显示 错误: 参数类型错误: stringp 3， 检查了下，有几处笔误，比如，有的地方是str ，有的是strl ,  还有"lib(003") 这里少了一个括号，修正了后还是运行不了，请大师再看看

lucas3

Free-Lancer 发表于 2014-10-5 17:34
有些函数还在调整中

大师，谢谢，现在可以运行，运行line,circle ,rectang 是没有问题，可是，我换成其它带对话框的lisp程序中的命令，就不行了，比如一个lisp程序，命令为XDTT，加载后 直接调用XDTT是没有问题，可是将您这个程序中的(command ".LINE") 换成 (command ".XDTT"),  执行就显示.XDTT 未知命令“XDTT”

Free-Lancer

lucas3 发表于 2014-10-5 18:30
大师，谢谢，现在可以运行，运行line,circle ,rectang 是没有问题，可是，我换成其它带对话框的lisp程序 ...

(c:xdtt)      

lucas3

Free-Lancer 发表于 2014-10-5 18:31
(c:xdtt)

perfect ！感谢大师的示列！非常典型的，像我这样的不懂代码的，也可以傻瓜式的组装适合自己的程序了！

lucas3

Free-Lancer 发表于 2014-10-5 18:31
(c:xdtt)

perfect ！感谢大师的示列！非常典型的，像我这样的不懂代码的，也可以傻瓜式的组装适合自己的程序了！