[求助]：请问如何实现点击dcl对话框中按钮执行lisp程序!

ld80721

请问如何实现点击dcl对话框中按钮执行lisp程序!
我想把积累的lisp小程序合在一块,通过面板中的按钮点击执行.
谢谢赐教!

似水无痕

到这里看一下，或许对你有帮助
http://p4.xdcad.net/forum/showth ... y=&pagenumber=1

ld80721

非常感谢似水无痕,我会珍惜你提供的资料.

似水无痕

不用感谢，我只是转个贴而已！

ld80721

似水无痕 ,你好,你能帮我写个范例吗?因本人愚昧,很喜欢这个.
代码:加宽直线(defun c:lw()
    (progn(write-line"\n 选择实体：")
        (setq selet (ssget))
    )
    (setq pw (getreal "\n输入线宽："))
    (setq n 0)
    (if(/= selet nil)
    (repeat(sslength selet)
        (setq entname(ssname selet n))
        (setq ent (entget entname))
        (setq name (cdr(assoc 0 ent)))
    (if(or(= name "LINE")(= name "ARC"))
          (command"pedit"entname"y""w" pw \r)
    )
    (if(= name "LWPOLYLINE")
        (command "pedit" entname "w" pw \r)
    )
          (setq n (1+ n))
          )
          )
(princ)
)
         
弧长标注
(defun C:hu (/ obj sel el e r ang angs ange larc pnt multi)
  (setvar "CMDECHO" 0)
  (setq multi (getvar 'dimlfac));;;add 2002.5.15 can remove
  (setq obj (entsel "\nSelect ARC:<Exit> "))
  (setq sel (car obj))
  
  (setq pnt (getpoint "point"))
   
  (terpri)
  (if (/= sel nil)
    (progn
      (setq el (entget sel))
      
      (setq e (assoc 0 el))
      (if (= "ARC" (cdr e))
        (progn
          (setq r (assoc 40 el))
          (setq r (cdr r))
          (setq angs (assoc 50 el))
          (setq angs (cdr angs))
          (setq ange (assoc 51 el))
          (setq ange (cdr ange))
          (setq ang (- ange angs))
          (if (< ang 0)
            (setq ang (- (* 2 pi) (abs ang)))
          )
          (setq larc (* r ang))
          (setq larc (* larc multi));;;add 2002.2.20 can remove
                                   ;;;add muti as multiple
          ;;;(princ "Angle = ")
          ;;;(prin1 (* (/ ang pi) 180))
          ;;;(princ " , Radius = ")
          ;;;(prin1 r)
          ;;;(princ "\nLength of ARC is : ")
          ;;;(prin1 larc)

          
        )
        (princ "Object is not a ARC !")
      )
    )
  )
  (setq larc  (rtos larc 2 1) )
(command "dimangular"  obj  "t" larc pnt )
  (princ)
)
期待佳音,非常感谢!
摸索了好几天一直搞不懂,万般无奈只有向你讨教了.
哈哈,见笑

附我想要的面板:

似水无痕

哪里都是长老和斑竹的程序，我用的是下拉列表框，大概改了一下，你试试好用么？
lsp文件：

2. 
   
3.   [FONT=courier new]
   
4. ;;
   
5. (defun c:test2 (/ dcl_id do_what)
   
6.   (if (> 0 (setq dcl_id (load_dialog "tslisp02.dcl")))
   
7.     (progn
   
8.       (princ "\n未能加载对话框文件：tslisp02.dcl")
   
9.       (setq dialogloaded nil)
   
10.     )
    
11.   )
    
12.   (setq do_what 2)
    
13.   (while (>= do_what 2)
    
14.     (if        (= null (new_dialog "tslisp02" dcl_id))
    
15.       (progn
    
16.         (princ "\n未能显示输入键槽参数对话框。")
    
17.         (setq dialogshow nil)
    
18.         (exit)
    
19.       )                                        ;progn结束
    
20.     )
    
21.     (action_tile "p_list" "(p_list)")
    
22.     (action_tile
    
23.       "accept"
    
24.       "(done_dialog 1)"
    
25.     )
    
26.     (action_tile "cancel" "(done_dialog 0)")
    
27.     (setq do_what (start_dialog))
    
28.     (cond ((= do_what 1)
    
29.            (if (= p_command "lw")
    
30.              (c:lw)
    
31.            )
    
32.            (if (= p_command "hu")
    
33.              (c:hu)
    
34.            )
    
35.           )
    
36.           ((= do_what 0)
    
37.            (exit)
    
38.            (prompt "\n对话框被取消。")
    
39.           )
    
40.     )
    
41.     (unload_dialog dcl_id)
    
42.   )
    
43. )
    
44. (defun p_list ()
    
45.   (setq        pr_index  (get_tile "p_list")
    
46.         pr_list          '("lw" "hu")
    
47.         p_command (nth (atoi pr_index) pr_list)
    
48.   )
    
49. )
    
50.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;<br /> (defun c:test2 (/ dcl_id do_what)<br />   (if (> 0 (setq dcl_id (load_dialog "tslisp02.dcl")))<br />     (progn<br />       (princ "\n未能加载对话框文件：tslisp02.dcl")<br />       (setq dialogloaded nil)<br />     )<br />   )<br />   (setq do_what 2)<br />   (while (>= do_what 2)<br />     (if        (= null (new_dialog "tslisp02" dcl_id))<br />       (progn<br />         (princ "\n未能显示输入键槽参数对话框。")<br />         (setq dialogshow nil)<br />         (exit)<br />       )                                        ;progn结束<br />     )<br />     (action_tile "p_list" "(p_list)")<br />     (action_tile<br />       "accept"<br />       "(done_dialog 1)"<br />     )<br />     (action_tile "cancel" "(done_dialog 0)")<br />     (setq do_what (start_dialog))<br />     (cond ((= do_what 1)<br />            (if (= p_command "lw")<br />              (c:lw)<br />            )<br />            (if (= p_command "hu")<br />              (c:hu)<br />            )<br />           )<br />           ((= do_what 0)<br />            (exit)<br />            (prompt "\n对话框被取消。")<br />           )<br />     )<br />     (unload_dialog dcl_id)<br />   )<br /> )<br /> (defun p_list ()<br />   (setq        pr_index  (get_tile "p_list")<br />         pr_list          '("lw" "hu")<br />         p_command (nth (atoi pr_index) pr_list)<br />   )<br /> )<br />   [/FONT]<br />

DCL文件：

2. 
   
3.   [FONT=courier new]
   
4. tslisp02:dialog{
   
5.         label="LISP程式列表";
   
6.         spacer;
   
7.                 :popup_list{
   
8.                         label="列表：";
   
9.                         key="p_list";
   
10.                         width=12;
    
11.                         list="lw\nhu";
    
12.                         value="lw";
    
13.                 }
    
14.                 spacer;
    
15.         ok_cancel;
    
16. }
    
17.   [/FONT]
    

<br />   [FONT=courier new]<br /> tslisp02:dialog{<br />         label="LISP程式列表";<br />         spacer;<br />                 :popup_list{<br />                         label="列表：";<br />                         key="p_list";<br />                         width=12;<br />                         list="lw\nhu";<br />                         value="lw";<br />                 }<br />                 spacer;<br />         ok_cancel;<br /> }<br />   [/FONT]<br />

ld80721

谢谢,我先试试.再行恢复!