[教学]：一个动态对话框的实例，高手免进~

wkai

一个动态对话框的实例

2. 
   
3.   [FONT=courier new]
   
4. ;_一个动态对话框的实例__BY__WKAI__晓东CAD论坛
   
5. ;_____________________________________________
   
6.   (defun c:tt (/ flag s ent_lst n ss_lst e index_value nn del_ss)
   
7.     ;____________________________
   
8.   (defun convert_string_to_lst (str ch / lst n s1 cha)
   
9.     (setq s1 ""
   
10.           n  0
    
11.     )
    
12.     (repeat (strlen str)
    
13.       (setq cha (substr str (setq n (1+ n)) 1))
    
14.       (if (= ch cha)
    
15.         (setq lst (append lst (list s1))
    
16.               s1  ""
    
17.         )
    
18.         (setq s1 (strcat s1 cha))
    
19.       )
    
20.     )
    
21.     (setq lst (append lst (list (atoi s1))))
    
22.   )
    
23.     ;____________________________
    
24.   (defun *error* (msg)
    
25.     (if        f
    
26.       (close f)
    
27.     )
    
28.   )
    
29.     ;____________________________
    
30.   (setq dcl_name (car (convert_string_to_lst (getenv "ACAD") ";")))
    
31.   (setq dcl_name (strcat dcl_name "\\easysel" ".dcl"))
    
32.     ;_确定动态dcl文件的位置
    
33.   (setq ent_lst '(("LINE" "直线段") ("ARC" "圆弧") ("CIRCLE" "圆") ("ELLIPSE" "椭圆")("LWPOLYLINE" "轻装多义线")))
    
34.     ;_设定动态dcl的内容索引表ent_lst
    
35.   (setq        s    (ssget);_选择物体
    
36.         flag "run"  ;_设定标志
    
37.   )
    
38.   (while (and (> (sslength s) 0) (= "run" flag));_循环
    
39.     (SETQ f (OPEN dcl_name "w"));创建dcl文件
    
40.     (setq ss_lst nil
    
41.           n -1
    
42.     )
    
43.     (repeat (sslength s);_在选中的的物体中找到符合动态dcl的内容索引表的,生成一个表ss_lst
    
44.       (setq e (cdr (assoc 0 (entget (ssname s (setq n (1+ n)))))))
    
45.       (setq ss_lst (if (or (not (assoc e ent_lst)) (member e ss_lst))
    
46.                      ss_lst
    
47.                      (append ss_lst (list e))
    
48.                    )
    
49.       )
    
50.     )
    
51.     (write-line "ss:dialog{label="test";\n:column{\n" f);_写入dcl文件的第行
    
52.     (if        ss_lst
    
53.       (foreach n ss_lst ;_循环生成按钮,写入dcl文件
    
54.         (write-line
    
55.           (strcat ":button{label="删除" (cadr (assoc n ent_lst)) "";key="" n "";}")
    
56.           f
    
57.         )
    
58.       )
    
59.       (progn
    
60.         (write-line ":text{label="没有选中指定的实体类型!";}" f)
    
61.         (write-line ":text{label="ent_lst中设定的实体类型如下:";}" f)
    
62.         (foreach n ent_lst
    
63.           (write-line
    
64.             (strcat ":text{label="" (car n) "";}")
    
65.             f
    
66.           )
    
67.         )
    
68.       )
    
69.     )   
    
70.     (write-line "}ok_only;}" f);_写入dcl文件的最后一行
    
71.     (close f);_关闭文件
    
72.     (setq index_value (load_dialog dcl_name));_加载dcl文件
    
73.     (new_dialog "ss" index_value);_开始新对话框
    
74.     (foreach nn        ss_lst
    
75.       (action_tile
    
76.         nn
    
77.         (strcat "( done_dialog " (itoa (vl-position (assoc nn ent_lst) ent_lst)) ")")
    
78.         ;_给按钮添加动作,用类型在ent_lst中的序号为参数完成对话框
    
79.       )
    
80.     )
    
81.     (action_tile "accept" "(done_dialog -1)");_设置OK按钮的完成参数为-1
    
82.     (setq flag (start_dialog));_用flag获得对话框的完成参数,可以知道用户点击了哪个按钮
    
83.     (if        (/= -1 flag);_如果用户按的不是ok
    
84.       (progn
    
85.         (command "._select" s "")
    
86.         (setq del_ss (ssget "p" (list (cons 0 (car(nth  flag ent_lst)))) ));_获得属于被删除物体的选择集
    
87.         (command "._select" s "r" del_ss "")
    
88.         (setq s (ssget "p"));_获得去除被删除物体后的选择集
    
89.         (command "._erase" del_ss "");_删除物体
    
90.         (setq flag "run");_设置继续运行标志
    
91.       )
    
92.     )
    
93.     (unload_dialog index_value);_卸载对话框
    
94.   )
    
95. )
    
96.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;_一个动态对话框的实例__BY__WKAI__晓东CAD论坛<br /> ;_____________________________________________<br />   (defun c:tt (/ flag s ent_lst n ss_lst e index_value nn del_ss)<br />     ;____________________________<br />   (defun convert_string_to_lst (str ch / lst n s1 cha)<br />     (setq s1 ""<br />           n  0<br />     )<br />     (repeat (strlen str)<br />       (setq cha (substr str (setq n (1+ n)) 1))<br />       (if (= ch cha)<br />         (setq lst (append lst (list s1))<br />               s1  ""<br />         )<br />         (setq s1 (strcat s1 cha))<br />       )<br />     )<br />     (setq lst (append lst (list (atoi s1))))<br />   )<br />     ;____________________________<br />   (defun *error* (msg)<br />     (if        f<br />       (close f)<br />     )<br />   )<br />     ;____________________________<br />   (setq dcl_name (car (convert_string_to_lst (getenv "ACAD") ";")))<br />   (setq dcl_name (strcat dcl_name "\\easysel" ".dcl"))<br />     ;_确定动态dcl文件的位置<br />   (setq ent_lst '(("LINE" "直线段") ("ARC" "圆弧") ("CIRCLE" "圆") ("ELLIPSE" "椭圆")("LWPOLYLINE" "轻装多义线")))<br />     ;_设定动态dcl的内容索引表ent_lst<br />   (setq        s    (ssget);_选择物体<br />         flag "run"  ;_设定标志<br />   )<br />   (while (and (> (sslength s) 0) (= "run" flag));_循环<br />     (SETQ f (OPEN dcl_name "w"));创建dcl文件<br />     (setq ss_lst nil<br />           n -1<br />     )<br />     (repeat (sslength s);_在选中的的物体中找到符合动态dcl的内容索引表的,生成一个表ss_lst<br />       (setq e (cdr (assoc 0 (entget (ssname s (setq n (1+ n)))))))<br />       (setq ss_lst (if (or (not (assoc e ent_lst)) (member e ss_lst))<br />                      ss_lst<br />                      (append ss_lst (list e))<br />                    )<br />       )<br />     )<br />     (write-line "ss:dialog{label="test";\n:column{\n" f);_写入dcl文件的第行<br />     (if        ss_lst<br />       (foreach n ss_lst ;_循环生成按钮,写入dcl文件<br />         (write-line<br />           (strcat ":button{label="删除" (cadr (assoc n ent_lst)) "";key="" n "";}")<br />           f<br />         )<br />       )<br />       (progn<br />         (write-line ":text{label="没有选中指定的实体类型!";}" f)<br />         (write-line ":text{label="ent_lst中设定的实体类型如下:";}" f)<br />         (foreach n ent_lst<br />           (write-line<br />             (strcat ":text{label="" (car n) "";}")<br />             f<br />           )<br />         )<br />       )<br />     )    <br />     (write-line "}ok_only;}" f);_写入dcl文件的最后一行<br />     (close f);_关闭文件<br />     (setq index_value (load_dialog dcl_name));_加载dcl文件<br />     (new_dialog "ss" index_value);_开始新对话框<br />     (foreach nn        ss_lst<br />       (action_tile<br />         nn<br />         (strcat "( done_dialog " (itoa (vl-position (assoc nn ent_lst) ent_lst)) ")")<br />         ;_给按钮添加动作,用类型在ent_lst中的序号为参数完成对话框<br />       )<br />     )<br />     (action_tile "accept" "(done_dialog -1)");_设置OK按钮的完成参数为-1<br />     (setq flag (start_dialog));_用flag获得对话框的完成参数,可以知道用户点击了哪个按钮<br />     (if        (/= -1 flag);_如果用户按的不是ok<br />       (progn<br />         (command "._select" s "")<br />         (setq del_ss (ssget "p" (list (cons 0 (car(nth  flag ent_lst)))) ));_获得属于被删除物体的选择集<br />         (command "._select" s "r" del_ss "")<br />         (setq s (ssget "p"));_获得去除被删除物体后的选择集<br />         (command "._erase" del_ss "");_删除物体<br />         (setq flag "run");_设置继续运行标志<br />       )<br />     )<br />     (unload_dialog index_value);_卸载对话框<br />   )<br /> )<br />   [/FONT]<br />

演示:

aeo

(getenv "ACAD")  --> (getenv "temp") 好些

功能再多一点，要考虑全面，是不简单的.

cy956

现在可懒了，碰上这样的问题，全交给doslib。。。

丹佛

太厉害了，敬礼！

urljit

楼主的创意实在是高，恐怕能利用这个方法修改button的label 吧。

jx2008

楼主是在世太高明了，能做到这样的好，佩服了，绝对支持。但是提点建议，就是实现的功能只能是删除，其他功能没有了，能否扩展充实呢？不过好像也没有必要啊，cad系统自带的右键菜单都有啊

黄河之水

我也是新手,敬佩

ampamp

不错,我试一试.

xihuliuyue

确实不错，不过全删的时候不是很多吧，