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

weiqi

命令：xzj 调出选择集

命令：delxzj删除选择集

同个DWG文件，关闭后再打开有效。
记得在 --op---选项 ----文件---文件支持搜索路径---加入DCL所在文件夹
代码实在是丑~~~莫见怪~

xsso

这是利用词典原理吗？对词典不太了解研究研究

xsso

词典保存，由于选择集保存不了，选择集直接写入vlax-ldata会出现不可串行保存不了，所以转成句柄 保存。然后再转成选择对象


竟然要转换这么多次先记录起来，说不定以后有用

weiqi

增加 多个选择集 记忆~
可删除已保存的选择集。
命令改为:dcxz 调出选择集
删除选择集命令为：delxz

1. ;;调出选择集
   
2. (defun c:dcxz()
   
3. (print (vlax-ldata-list "tykm" ));;字段第一位为 选择集名称
   
4. (print )
   
5. (setq jyname (getstring "选择集名称： "))
   
6. (xzss (vlax-ldata-get "tykm" jyname))
   
7. (command "move" ss1 nil)
   
8. (sssetfirst nil ss1)
   
9. )
   
10. ;;删除选择
    
11. (defun c:delxz()
    
12. (print (vlax-ldata-list "tykm" ))
    
13. (print )
    
14. (setq jyname (getstring "请输入要删除的选择集名称： "))
    
15. (vlax-ldata-delete "tykm" jyname)
    
16. 
    
17. )
    
18. 
    
19. 
    
20. 
    
21. ;;选择写入 选择集 句柄写入词典
    
22. (defun c:xzxr()
    
23. (setq jyname (getstring "选择集名称： "))
    
24. (setq listxz nil)
    
25. 
    
26. (setq xzj (ssget))
    
27. 
    
28. (setq namen 0)
    
29. (repeat  (sslength xzj)
    
30. (setq xname (ssname xzj namen))
    
31. (setq listxz (append listxz (list (cdr (assoc 5 (entget xname))))))
    
32. ;;(setq listxz (append listxz (list xname)))
    
33. 
    
34. (setq namen (+ namen 1))
    
35. 
    
36. 
    
37. )
    
38. (print listxz)
    
39. 
    
40. (vlax-ldata-put "tykm" jyname listxz)
    
41. 
    
42. )
    
43. 
    
44. 
    
45. 
    
46. 
    
47. ;;句柄转 图元名  并 组成选择集SS1
    
48. ;;(xzss (vlax-ldata-get "tykm" "kym"))
    
49. (defun xzss(n)
    
50. (print n)
    
51. (setq xzzb n)
    
52. (setq xzbb 0 )
    
53. ;;(setq xzzb (vlax-ldata-get "tykm" "kym"))
    
54. (setq xzzbn nil)
    
55. (setq xz1 nil)
    
56. 
    
57. (setq ss1 (ssadd))
    
58. (repeat (length xzzb)
    
59. (setq xzzbn (append xzzbn (list (handent (car xzzb)))))
    
60. 
    
61. (ssadd (handent (car xzzb)) ss1)
    
62. (setq xzzb (cdr xzzb))
    
63. 
    
64. (setq xzbb (+ xzbb 1))
    
65. 
    
66. )
    
67. 
    
68. 
    
69. (print xzzbn)
    
70. (print)
    
71. 
    
72. )
    
73. 
    
74. 
    
75. 
    

;;调出选择集<br /> (defun c:dcxz()<br /> (print (vlax-ldata-list "tykm" ));;字段第一位为 选择集名称<br /> (print )<br /> (setq jyname (getstring "选择集名称： "))<br /> (xzss (vlax-ldata-get "tykm" jyname))<br /> (command "move" ss1 nil)<br /> (sssetfirst nil ss1)<br /> )<br /> ;;删除选择<br /> (defun c:delxz()<br /> (print (vlax-ldata-list "tykm" ))<br /> (print )<br /> (setq jyname (getstring "请输入要删除的选择集名称： "))<br /> (vlax-ldata-delete "tykm" jyname)<br /> <br /> )<br /> <br /> <br /> <br /> ;;选择写入 选择集 句柄写入词典<br /> (defun c:xzxr()<br /> (setq jyname (getstring "选择集名称： ")) <br /> (setq listxz nil)<br /> <br /> (setq xzj (ssget))<br /> <br /> (setq namen 0)<br /> (repeat  (sslength xzj)<br /> (setq xname (ssname xzj namen))<br /> (setq listxz (append listxz (list (cdr (assoc 5 (entget xname))))))<br /> ;;(setq listxz (append listxz (list xname)))<br /> <br /> (setq namen (+ namen 1))<br /> <br /> <br /> )<br /> (print listxz)<br /> <br /> (vlax-ldata-put "tykm" jyname listxz)<br /> <br /> )<br /> <br /> <br /> <br /> <br /> ;;句柄转 图元名  并 组成选择集SS1<br /> ;;(xzss (vlax-ldata-get "tykm" "kym"))<br /> (defun xzss(n)<br /> (print n)<br /> (setq xzzb n)<br /> (setq xzbb 0 )<br /> ;;(setq xzzb (vlax-ldata-get "tykm" "kym"))<br /> (setq xzzbn nil)<br /> (setq xz1 nil)<br /> <br /> (setq ss1 (ssadd))<br /> (repeat (length xzzb)<br /> (setq xzzbn (append xzzbn (list (handent (car xzzb)))))<br /> <br /> (ssadd (handent (car xzzb)) ss1)<br /> (setq xzzb (cdr xzzb))<br /> <br /> (setq xzbb (+ xzbb 1))<br /> <br /> )<br /> <br /> <br /> (print xzzbn)<br /> (print)<br /> <br /> )<br /> <br /> <br /> <br />

貌似有的CAD 词典KEY显示不全。本人试过2007就显示不全，
改用CAD 2008就全了。隔壁有个帖子正说这问题，暂时没啥办法。

如果vlax-ldata-list 不全的话 输出出来是看不到全称的，
但是你之前写了什么，写全称的话 还是有用的。

xyp1964

基本属于鸡肋！

自贡黄明儒

同X版想法不同，要多鼓励年轻人。
想法还是不错的，也很有办法，努力加油！！！

yzr2002626

全部功能集成在一个命令里面。感觉在一个DCL操作要好得多

hpy

感觉还是有用处的。支持一下。

自贡黄明儒

我还没有发现它的用处，不过觉得很意思，所以改写了一下

2. ;;自贡黄明儒
   
3. ;;调出选择集
   
4. (defun c:ChooseSS (/ LIS SSNAM X)
   
5. 
   
6.   ;;(xzss 选择集名称),返回选择集
   
7.   (defun xzss (SSNam / N1 RESULT SS1)
   
8.     (setq result (VL-CATCH-ALL-APPLY 'vlax-ldata-get (list "tykm" SSNam)))
   
9.     (if        (VL-CATCH-ALL-ERROR-P result)
   
10.       nil
    
11.       (progn
    
12.         (setq ss1 (ssadd))
    
13.         (repeat        (length result)
    
14.           (setq n1 (car result))
    
15.           (setq result (cdr result))
    
16.           (ssadd (handent n1) ss1)
    
17.         )
    
18.       )
    
19.     )
    
20.     (sssetfirst nil ss1)
    
21.   )
    
22. 
    
23.   (if (setq lis (vlax-ldata-list "tykm"))
    
24.     (progn (princ (strcat "\n 已经存在选择集 "
    
25.                           (apply 'strcat (mapcar '(lambda (x) (strcat (car x) ",")) lis))
    
26.                   )
    
27.            )
    
28.            ;;(initget 7)
    
29.            (setq SSNam (getstring "\n 选择集名称： "))
    
30.            (VL-CATCH-ALL-APPLY 'xzss (list SSNam))
    
31.     )
    
32.   )
    
33.   (princ)
    
34. )
    
35. 
    
36. ;;删除选择
    
37. (defun c:DelSS (/ LIS SSNAM X)
    
38.   ;;(initget 7)
    
39.   (if (setq lis (vlax-ldata-list "tykm"))
    
40.     (progn (princ (strcat "\n 已经存在选择集 "
    
41.                           (apply 'strcat (mapcar '(lambda (x) (strcat (car x) ",")) lis))
    
42.                   )
    
43.            )
    
44.            (setq SSNam (getstring "\n 选择集名称： "))
    
45.            (VL-CATCH-ALL-APPLY 'vlax-ldata-delete (list "tykm" SSNam))
    
46.     )
    
47.   )
    
48.   (princ)
    
49. )
    
50. 
    
51. ;;选择集成员句柄写入词典，随图一起保存
    
52. (defun c:CreateSS (/ LIS LISTXZ N SSNAM X en SS)
    
53.   (if (setq lis (vlax-ldata-list "tykm"))
    
54.     (princ (strcat "\n 已经存在选择集 "
    
55.                    (BAtte:lst->str (mapcar '(lambda (x) (car x)) lis) ",")
    
56.            )
    
57.     )
    
58.   )
    
59.   ;;(initget 7)
    
60.   (if (and (setq SSNam (getstring "\n 选择集名称： "))
    
61.            (setq SS (ssget))
    
62.       )
    
63.     (progn
    
64.       (repeat (setq n (sslength SS))
    
65.         (setq en (ssname SS (setq n (1- n))))
    
66.         (setq listxz (append listxz (list (cdr (assoc 5 (entget en))))))
    
67.       )
    
68.       (VL-CATCH-ALL-APPLY 'vlax-ldata-put (list "tykm" SSNam listxz))
    
69.     )
    
70.   )
    
71.   (princ)
    
72. )
    
73. 
    
74. ;;(BAtte:lst->str (list "A" "B") ","),返回"A,B"
    
75. (defun BAtte:lst->str (lst del)
    
76.   (if (cdr lst)
    
77.     (strcat (car lst) del (BAtte:lst->str (cdr lst) del))
    
78.     (car lst)
    
79.   )
    
80. )
    
81. 
    
82. ;;(BAtte:str->lst "A,B" ",")返回("A" "B")
    
83. (defun BAtte:str->lst (str del / pos)
    
84.   (if (setq pos (vl-string-search del str))
    
85.     (cons (substr str 1 pos)
    
86.           (BAtte:str->lst (substr str (+ pos 1 (strlen del))) del)
    
87.     )
    
88.     (list str)
    
89.   )
    
90. )
    
91. 
    
92. 
    
93. 
    
94. 
    
95. 
    
96. 
    
97. 
    

;;自贡黄明儒<br /> ;;调出选择集<br /> (defun c:ChooseSS (/ LIS SSNAM X)<br /> <br />   ;;(xzss 选择集名称),返回选择集<br />   (defun xzss (SSNam / N1 RESULT SS1)<br />     (setq result (VL-CATCH-ALL-APPLY 'vlax-ldata-get (list "tykm" 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 /> <br />   (if (setq lis (vlax-ldata-list "tykm"))<br />     (progn (princ (strcat "\n 已经存在选择集 "<br />                           (apply 'strcat (mapcar '(lambda (x) (strcat (car x) ",")) lis))<br />                   )<br />            )<br />            ;;(initget 7)<br />            (setq SSNam (getstring "\n 选择集名称： "))<br />            (VL-CATCH-ALL-APPLY 'xzss (list SSNam))<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> ;;删除选择<br /> (defun c:DelSS (/ LIS SSNAM X)<br />   ;;(initget 7)<br />   (if (setq lis (vlax-ldata-list "tykm"))<br />     (progn (princ (strcat "\n 已经存在选择集 "<br />                           (apply 'strcat (mapcar '(lambda (x) (strcat (car x) ",")) lis))<br />                   )<br />            )<br />            (setq SSNam (getstring "\n 选择集名称： "))<br />            (VL-CATCH-ALL-APPLY 'vlax-ldata-delete (list "tykm" SSNam))<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> ;;选择集成员句柄写入词典，随图一起保存<br /> (defun c:CreateSS (/ LIS LISTXZ N SSNAM X en SS)<br />   (if (setq lis (vlax-ldata-list "tykm"))<br />     (princ (strcat "\n 已经存在选择集 "<br />                    (BAtte:lst->str (mapcar '(lambda (x) (car x)) lis) ",")<br />            )<br />     )<br />   )<br />   ;;(initget 7)<br />   (if (and (setq SSNam (getstring "\n 选择集名称： "))<br />            (setq SS (ssget))<br />       )<br />     (progn<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 "tykm" SSNam listxz))<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> ;;(BAtte:lst->str (list "A" "B") ","),返回"A,B"<br /> (defun BAtte:lst->str (lst del)<br />   (if (cdr lst)<br />     (strcat (car lst) del (BAtte:lst->str (cdr lst) del))<br />     (car lst)<br />   )<br /> )<br /> <br /> ;;(BAtte:str->lst "A,B" ",")返回("A" "B")<br /> (defun BAtte:str->lst (str del / pos)<br />   (if (setq pos (vl-string-search del str))<br />     (cons (substr str 1 pos)<br />           (BAtte:str->lst (substr str (+ pos 1 (strlen del))) del)<br />     )<br />     (list str)<br />   )<br /> )<br /> <br /> <br /> <br /> <br /> <br /> <br /> <br />

weiqi

久时不来，什么都忘光了，突然想写个程序，连选择集，一个一个输出都想不起来了。
CAR。。。