记忆选择集，关闭DWG有效加入DCL

xyp1964

;; 记忆选择

smartstar

创意不错！支持一下！

hhhlike

这个功能挺有用的，顶一下

tianyi1230

贱人工具箱里面有个选择集功能，就是和院长的插件功能一样

xieyanghui

院长这个不错。那位高手山寨个！

springwillow

期待完善能在对话框中操作选择集。那样就方便多了

yzr2002626

哪为完善下撒，在一个命令中完成，就像院长那个一样的，能多选

海盗曹

好想法，好程序，学习了~

mj0000

大神都不出手做对话框版么？
我先抛块砖

2. (defun c:ST (/ SSLists)
   
3.   (setq SSLists (Sub-SS-SSLists))
   
4.   (dcl_contents SSLists)
   
5. )
   
6. 
   
7. (defun dcl_contents (SSLists / dcl_id S_D)
   
8.   (sssetfirst)
   
9.   (if (> (setq dcl_id (load_dialog "随图选择集")) 0)
   
10.     (if        (new_dialog "SuiTuSS" dcl_id)
    
11.       (progn (action_tile "AddSS" "(done_dialog 1)")
    
12.              (action_tile "ChsSS" "(done_dialog 2)")
    
13.              (action_tile "DelSS" "(done_dialog 3)")
    
14.              (action_tile "SSName" "(setq SSNam $value)")
    
15. 
    
16.              (start_list "SSList") ;_已有选择集列表
    
17.              (mapcar 'add_list SSLists)
    
18.              (end_list)
    
19.              (action_tile "SSList" "(setq SSLst $value)")
    
20.              (mode_tile "SSName" 2) ;_鼠标焦点
    
21. 
    
22.              (action_tile "cancel" "(done_dialog 0)")
    
23.              (setq S_D (start_dialog))
    
24.              (cond
    
25.                ((= S_D 1) (Sub-SS-CreateSS SSNam))
    
26.                ((= S_D 2) (Sub-SS-ChooseSS (nth (read SSLst) SSLists)))
    
27.                ((= S_D 3) (Sub-SS-DelSS (nth (read SSLst) SSLists)))
    
28.              )
    
29.              (start_dialog)
    
30.              (unload_dialog dcl_id)
    
31.       )
    
32.       (princ "\n无法显示对话框！")
    
33.     )
    
34.     (princ "\n无法加载对话框！")
    
35.   )
    
36.   (princ)
    
37. )
    
38. 
    
39. ;;;================================================================================
    
40. ;;;自贡黄明儒
    
41. (defun Sub-SS-CreateSS (SSNam / SS n en listxz SSLists)
    
42.   (if SSNam
    
43.     (progn
    
44.       (setq SS (ssget))
    
45.       (repeat (setq n (sslength SS))
    
46.         (setq en (ssname SS (setq n (1- n))))
    
47.         (setq listxz (append listxz (list (cdr (assoc 5 (entget en))))))
    
48.       )
    
49.       (VL-CATCH-ALL-APPLY 'vlax-ldata-put (list "SS-Data-SSXZJ" SSNam listxz))
    
50.     )
    
51.   )
    
52.   (setq SSLists (Sub-SS-SSLists))
    
53.   (dcl_contents SSLists)
    
54. )
    
55. ;;调出选择集
    
56. (defun Sub-SS-ChooseSS (SSNam / N1 RESULT SS1)
    
57.   (setq result (VL-CATCH-ALL-APPLY 'vlax-ldata-get (list "SS-Data-SSXZJ" SSNam)))
    
58.   (if (VL-CATCH-ALL-ERROR-P result)
    
59.     nil
    
60.     (progn
    
61.       (setq ss1 (ssadd))
    
62.       (repeat (length result)
    
63.         (setq n1 (car result))
    
64.         (setq result (cdr result))
    
65.         (ssadd (handent n1) ss1)
    
66.       )
    
67.     )
    
68.   )
    
69.   (sssetfirst nil ss1)
    
70. )
    
71. (defun Sub-SS-DelSS (SSNAM / SSLists)
    
72.   (VL-CATCH-ALL-APPLY 'vlax-ldata-delete (list "SS-Data-SSXZJ" SSNam)) ;_删除单个选择集
    
73.   (setq SSLists (Sub-SS-SSLists))
    
74.   (dcl_contents SSLists)
    
75. )
    
76. 
    
77. (defun Sub-SS-DelSSAll (/ SSLists)
    
78.   (YX:Put-Dict-DelDict "SS-Data-SSXZJ") ;_删除词典，清空选择集
    
79.   (setq SSLists (Sub-SS-SSLists))
    
80.   (dcl_contents SSLists)
    
81. )
    
82. 
    
83. (defun Sub-SS-SSLists (/ LIS SSNAMS X)
    
84.   (if (setq lis (vlax-ldata-list "SS-Data-SSXZJ"))
    
85.     (setq SSNAMlst (mapcar '(lambda (x) (car x)) lis))
    
86.     (setq SSNAMlst nil)
    
87.   )
    
88. )
    

(defun c:ST (/ SSLists)<br />   (setq SSLists (Sub-SS-SSLists))<br />   (dcl_contents SSLists)<br /> )<br /> <br /> (defun dcl_contents (SSLists / dcl_id S_D)<br />   (sssetfirst)<br />   (if (> (setq dcl_id (load_dialog "随图选择集")) 0)<br />     (if        (new_dialog "SuiTuSS" dcl_id)<br />       (progn (action_tile "AddSS" "(done_dialog 1)")<br />              (action_tile "ChsSS" "(done_dialog 2)")<br />              (action_tile "DelSS" "(done_dialog 3)")<br />              (action_tile "SSName" "(setq SSNam $value)")<br /> <br />              (start_list "SSList") ;_已有选择集列表<br />              (mapcar 'add_list SSLists)<br />              (end_list)<br />              (action_tile "SSList" "(setq SSLst $value)")<br />              (mode_tile "SSName" 2) ;_鼠标焦点<br /> <br />              (action_tile "cancel" "(done_dialog 0)")<br />              (setq S_D (start_dialog))<br />              (cond<br />                ((= S_D 1) (Sub-SS-CreateSS SSNam))<br />                ((= S_D 2) (Sub-SS-ChooseSS (nth (read SSLst) SSLists)))<br />                ((= S_D 3) (Sub-SS-DelSS (nth (read SSLst) SSLists)))<br />              )<br />              (start_dialog)<br />              (unload_dialog dcl_id)<br />       )<br />       (princ "\n无法显示对话框！")<br />     )<br />     (princ "\n无法加载对话框！")<br />   )<br />   (princ)<br /> )<br /> <br /> ;;;================================================================================<br /> ;;;自贡黄明儒<br /> (defun Sub-SS-CreateSS (SSNam / SS n en listxz SSLists)<br />   (if SSNam<br />     (progn<br />       (setq SS (ssget))<br />       (repeat (setq n (sslength SS))<br />         (setq en (ssname SS (setq n (1- n))))<br />         (setq listxz (append listxz (list (cdr (assoc 5 (entget en))))))<br />       )<br />       (VL-CATCH-ALL-APPLY 'vlax-ldata-put (list "SS-Data-SSXZJ" SSNam listxz))<br />     )<br />   )<br />   (setq SSLists (Sub-SS-SSLists))<br />   (dcl_contents SSLists)<br /> )<br /> ;;调出选择集<br /> (defun Sub-SS-ChooseSS (SSNam / N1 RESULT SS1)<br />   (setq result (VL-CATCH-ALL-APPLY 'vlax-ldata-get (list "SS-Data-SSXZJ" SSNam)))<br />   (if (VL-CATCH-ALL-ERROR-P result)<br />     nil<br />     (progn<br />       (setq ss1 (ssadd))<br />       (repeat (length result)<br />         (setq n1 (car result))<br />         (setq result (cdr result))<br />         (ssadd (handent n1) ss1)<br />       )<br />     )<br />   )<br />   (sssetfirst nil ss1)<br /> )<br /> (defun Sub-SS-DelSS (SSNAM / SSLists)<br />   (VL-CATCH-ALL-APPLY 'vlax-ldata-delete (list "SS-Data-SSXZJ" SSNam)) ;_删除单个选择集<br />   (setq SSLists (Sub-SS-SSLists))<br />   (dcl_contents SSLists)<br /> )<br /> <br /> (defun Sub-SS-DelSSAll (/ SSLists)<br />   (YX:Put-Dict-DelDict "SS-Data-SSXZJ") ;_删除词典，清空选择集<br />   (setq SSLists (Sub-SS-SSLists))<br />   (dcl_contents SSLists)<br /> )<br /> <br /> (defun Sub-SS-SSLists (/ LIS SSNAMS X)<br />   (if (setq lis (vlax-ldata-list "SS-Data-SSXZJ"))<br />     (setq SSNAMlst (mapcar '(lambda (x) (car x)) lis))<br />     (setq SSNAMlst nil)<br />   )<br /> )<br />

mj0000

DCL文件：随图选择集.DCL

1. dcl_settings : default_dcl_settings { audit_level = 0 ; }SuiTuSS : dialog {    label = "随图选择集";    : boxed_column {        : row {            : button {                label = "添加";                key = "AddSS";            }            : edit_box {                key = "SSName";            }        }        : list_box {            label = "已有选择集";            key = "SSList";                   }        : row {            : button {                label = "调用";                key = "ChsSS";                is_default = true;                is_cancel = true;            }            : button {                label = "删除";                key = "DelSS";            }        }    }    spacer_1;    cancel_button;}

dcl_settings : default_dcl_settings { audit_level = 0 ; }SuiTuSS : dialog {    label = "随图选择集";    : boxed_column {        : row {            : button {                label = "添加";                key = "AddSS";            }            : edit_box {                key = "SSName";            }        }        : list_box {            label = "已有选择集";            key = "SSList";                   }        : row {            : button {                label = "调用";                key = "ChsSS";                is_default = true;                is_cancel = true;            }            : button {                label = "删除";                key = "DelSS";            }        }    }    spacer_1;    cancel_button;}