应用sssetfirst后，可能导致程序死循环

USER2128

我的机器配置：ACAD2012，32位，WINXP 8G内存
应用sssetfirst后，可能会导致程序死循环（绝大多数情况是）

以下有两个主程序TT1和TT2。
程序TT1应用了sssetfirst，导致死循环，程序TT2避开了sssetfirst，运行正常。

2. ;;; 程序作者：USER2128，QQ：781400968，如有建议望联系。
   
3. ;;;----------------------------------------------------
   
4. ;;; 本段程序有可能导致死循环，请及时按“Esc”键终止，否则导致CAD崩溃
   
5. (defun c:tt1()
   
6.   (while (setq ss (ssget ":s"))
   
7.     (setq blk-a1 (ssget "p" '((0 . "INSERT") (2 . "A3"))))
   
8.     (if blk-a1
   
9.       (progn        ;有"A3"块的情况，亮显"A3"块
   
10.         (repeat (setq cnt (sslength blk-a1))
    
11.         (setq con-pt (GetSSBoundingbox ss))        ;单个实体或选择集的最小包围框
    
12. ;;; 高亮"A3"块:
    
13.           (redraw (ssname blk-a1 (setq cnt (1- cnt))) 3)
    
14.           );repeat.
    
15.         );progn
    
16.       (progn        ;无"A1,AA1"块时，亮显选择集
    
17.         (setq con-pt (GetSSBoundingbox ss))        ;单个实体或选择集的最小包围框
    
18. ;;; 亮显选择集
    
19.         (ayEntSSHighLight SS)        ;导致本段progn程序, 在此反复执行
    
20.         );progn
    
21.       );if
    
22.     );while
    
23.   con-pt);defun
    
24. 
    
25. ;;;---------------------------------------------------
    
26. ;;; 本段程序放心运行
    
27. (defun c:tt2()
    
28.   (while (setq ss (ssget ":s"))
    
29.     (setq blk-a1 (ssget "p" '((0 . "INSERT") (2 . "A3"))))
    
30.     (if blk-a1
    
31.       (progn        ;有"A3"块的情况，亮显"A3"块
    
32.         (repeat (setq cnt (sslength blk-a1))
    
33.         (setq con-pt (GetSSBoundingbox ss))        ;单个实体或选择集的最小包围框
    
34. ;;; 高亮"A3"块:
    
35.           (redraw (ssname blk-a1 (setq cnt (1- cnt))) 3)
    
36.           );repeat.
    
37.         );progn
    
38.       (progn        ;无"A1,AA1"块时，亮显选择集
    
39.         (setq con-pt (GetSSBoundingbox ss))        ;单个实体或选择集的最小包围框
    
40. ;;; 亮显选择集
    
41.         (repeat (setq cnt (sslength ss))
    
42.           (redraw (ssname ss (setq cnt (1- cnt))) 3)
    
43.           )
    
44.         );progn
    
45.       );if
    
46.     );while
    
47.   con-pt);defun
    
48. ;;;----------------------------------------------------------
    
49. ;;; 以下为上述程序要用到的子函数, 都来源于明经，部分稍有修改.
    
50. ;;;----------------------------------------------------------
    
51. ;功能：返回选择集包围盒
    
52. ;参数: ss--选择集
    
53. ;返回值：选择集所有实体做为整体的包围盒
    
54. ;| (setq ssbox (GetSSBoundingbox (ssget)))
    
55.          (command "._pline" "_non" (car ssbox) "_non" (list (caar ssbox) (cadadr ssbox))
    
56.              "_non" (cadr ssbox) "_non" (list (caadr ssbox) (cadar ssbox)) "_c")
    
57. |;
    
58. (defun GetSSBoundingbox (sse / ss i ssn ll rr box ptlist ssbox)
    
59.   (if (= 'ENAME (type sse))
    
60.     (progn (setq ss (ssadd)) (ssadd sse ss))
    
61.     (setq ss sse))
    
62.   (if ss
    
63.     (progn
    
64.       (setq i -1)
    
65.       (repeat (sslength ss)
    
66.         (setq ssn (ssname ss (setq i (1+ i))))
    
67.         (vla-GetBoundingBox (vlax-ename->vla-object ssn) 'll 'rr)  ;得到对象的包围盒
    
68.         (setq box (list (vlax-safearray->list ll) (vlax-safearray->list rr)))
    
69.         (setq ptlist (append ptlist box))
    
70.         )
    
71.       (setq ssbox (mapcar '(lambda (x) (apply 'mapcar (cons x ptlist))) (list 'min 'max)))
    
72.       )
    
73.     )
    
74.   )
    
75. ;;; 中心点:
    
76. ;   (setq midpt (mapcar '(lambda (a b) (/ (+ a b) 2)) (car ssbox) (cadr ssbox)))
    
77. ;;; 或:
    
78. ;   (setq midpt (apply 'mapcar (cons (function (lambda (a b) (/ (+ a b) 2))) ssbox)))
    
79. 
    
80. 
    
81. ;;;---------------------------------------------------
    
82. ;;;*****************************************
    
83. ;; No.6-3 亮显选择集或对象(夹点不显示) 函数
    
84. ;;;*****************************************
    
85. (defun ayEntSSHighLight(SSorEntName / oldGrips)
    
86.   (setq oldGrips (getvar "Grips"))
    
87.   (setvar "Grips" 0)
    
88.   (cond
    
89.     ((= (type SSorEntName) 'PICKSET);选择集.
    
90.      (sssetfirst nil SSorEntName)
    
91.      );end_switch
    
92.     ((= (type SSorEntName) 'ENAME);单一实体.
    
93.      (sssetfirst nil (ssadd SSorEntName (ssadd)))
    
94.      );end_switch
    
95.     );end_cond
    
96.   (setvar "Grips" oldGrips)
    
97. );end_defun
    
98. ;;;---------------------------------------------------
    
99. (princ)
    
100. 
     

;;; 程序作者：USER2128，QQ：781400968，如有建议望联系。<br /> ;;;----------------------------------------------------<br /> ;;; 本段程序有可能导致死循环，请及时按“Esc”键终止，否则导致CAD崩溃<br /> (defun c:tt1()<br />   (while (setq ss (ssget ":s"))<br />     (setq blk-a1 (ssget "p" '((0 . "INSERT") (2 . "A3"))))<br />     (if blk-a1<br />       (progn        ;有"A3"块的情况，亮显"A3"块<br />         (repeat (setq cnt (sslength blk-a1))<br />         (setq con-pt (GetSSBoundingbox ss))        ;单个实体或选择集的最小包围框<br /> ;;; 高亮"A3"块:<br />           (redraw (ssname blk-a1 (setq cnt (1- cnt))) 3)<br />           );repeat.<br />         );progn<br />       (progn        ;无"A1,AA1"块时，亮显选择集<br />         (setq con-pt (GetSSBoundingbox ss))        ;单个实体或选择集的最小包围框<br /> ;;; 亮显选择集<br />         (ayEntSSHighLight SS)        ;导致本段progn程序, 在此反复执行<br />         );progn<br />       );if<br />     );while<br />   con-pt);defun<br /> <br /> ;;;---------------------------------------------------<br /> ;;; 本段程序放心运行<br /> (defun c:tt2()<br />   (while (setq ss (ssget ":s"))<br />     (setq blk-a1 (ssget "p" '((0 . "INSERT") (2 . "A3"))))<br />     (if blk-a1<br />       (progn        ;有"A3"块的情况，亮显"A3"块<br />         (repeat (setq cnt (sslength blk-a1))<br />         (setq con-pt (GetSSBoundingbox ss))        ;单个实体或选择集的最小包围框<br /> ;;; 高亮"A3"块:<br />           (redraw (ssname blk-a1 (setq cnt (1- cnt))) 3)<br />           );repeat.<br />         );progn<br />       (progn        ;无"A1,AA1"块时，亮显选择集<br />         (setq con-pt (GetSSBoundingbox ss))        ;单个实体或选择集的最小包围框<br /> ;;; 亮显选择集<br />         (repeat (setq cnt (sslength ss))<br />           (redraw (ssname ss (setq cnt (1- cnt))) 3)<br />           )<br />         );progn<br />       );if<br />     );while<br />   con-pt);defun<br /> ;;;----------------------------------------------------------<br /> ;;; 以下为上述程序要用到的子函数, 都来源于明经，部分稍有修改.<br /> ;;;----------------------------------------------------------<br /> ;功能：返回选择集包围盒<br /> ;参数: ss--选择集<br /> ;返回值：选择集所有实体做为整体的包围盒<br /> ;| (setq ssbox (GetSSBoundingbox (ssget)))<br />          (command "._pline" "_non" (car ssbox) "_non" (list (caar ssbox) (cadadr ssbox))<br />              "_non" (cadr ssbox) "_non" (list (caadr ssbox) (cadar ssbox)) "_c")<br /> |;<br /> (defun GetSSBoundingbox (sse / ss i ssn ll rr box ptlist ssbox)<br />   (if (= 'ENAME (type sse))<br />     (progn (setq ss (ssadd)) (ssadd sse ss))<br />     (setq ss sse))<br />   (if ss<br />     (progn<br />       (setq i -1)<br />       (repeat (sslength ss)<br />         (setq ssn (ssname ss (setq i (1+ i))))<br />         (vla-GetBoundingBox (vlax-ename->vla-object ssn) 'll 'rr)  ;得到对象的包围盒<br />         (setq box (list (vlax-safearray->list ll) (vlax-safearray->list rr)))<br />         (setq ptlist (append ptlist box))<br />         )<br />       (setq ssbox (mapcar '(lambda (x) (apply 'mapcar (cons x ptlist))) (list 'min 'max)))<br />       )<br />     )<br />   )<br /> ;;; 中心点:<br /> ;   (setq midpt (mapcar '(lambda (a b) (/ (+ a b) 2)) (car ssbox) (cadr ssbox)))<br /> ;;; 或:<br /> ;   (setq midpt (apply 'mapcar (cons (function (lambda (a b) (/ (+ a b) 2))) ssbox)))<br /> <br /> <br /> ;;;---------------------------------------------------<br /> ;;;*****************************************<br /> ;; No.6-3 亮显选择集或对象(夹点不显示) 函数 <br /> ;;;*****************************************<br /> (defun ayEntSSHighLight(SSorEntName / oldGrips)<br />   (setq oldGrips (getvar "Grips"))<br />   (setvar "Grips" 0)<br />   (cond<br />     ((= (type SSorEntName) 'PICKSET);选择集.<br />      (sssetfirst nil SSorEntName)<br />      );end_switch<br />     ((= (type SSorEntName) 'ENAME);单一实体.<br />      (sssetfirst nil (ssadd SSorEntName (ssadd)))<br />      );end_switch<br />     );end_cond<br />   (setvar "Grips" oldGrips)<br /> );end_defun<br /> ;;;---------------------------------------------------<br /> (princ)<br /> <br />

测试图（R14格式）：

xinxirong

我调试了一下，发现是没跳出while循环的条件，跟sssetfirst没关吧？