应用sssetfirst后，可能导致程序死循环
本帖最后由 USER2128 于 2013-4-19 10:20 编辑我的机器配置：ACAD2012，32位，WINXP 8G内存
应用sssetfirst后，可能会导致程序死循环（绝大多数情况是）
以下有两个主程序TT1和TT2。
程序TT1应用了sssetfirst，导致死循环，程序TT2避开了sssetfirst，运行正常。
;;; 程序作者：USER2128，QQ：781400968，如有建议望联系。
;;;----------------------------------------------------
;;; 本段程序有可能导致死循环，请及时按“Esc”键终止，否则导致CAD崩溃
(defun c:tt1()
(while (setq ss (ssget ":s"))
(setq blk-a1 (ssget "p" '((0 . "INSERT") (2 . "A3"))))
(if blk-a1
(progn ;有"A3"块的情况，亮显"A3"块
(repeat (setq cnt (sslength blk-a1))
(setq con-pt (GetSSBoundingbox ss)) ;单个实体或选择集的最小包围框
;;; 高亮"A3"块:
(redraw (ssname blk-a1 (setq cnt (1- cnt))) 3)
);repeat.
);progn
(progn ;无"A1,AA1"块时，亮显选择集
(setq con-pt (GetSSBoundingbox ss)) ;单个实体或选择集的最小包围框
;;; 亮显选择集
(ayEntSSHighLight SS) ;导致本段progn程序, 在此反复执行
);progn
);if
);while
con-pt);defun
;;;---------------------------------------------------
;;; 本段程序放心运行
(defun c:tt2()
(while (setq ss (ssget ":s"))
(setq blk-a1 (ssget "p" '((0 . "INSERT") (2 . "A3"))))
(if blk-a1
(progn ;有"A3"块的情况，亮显"A3"块
(repeat (setq cnt (sslength blk-a1))
(setq con-pt (GetSSBoundingbox ss)) ;单个实体或选择集的最小包围框
;;; 高亮"A3"块:
(redraw (ssname blk-a1 (setq cnt (1- cnt))) 3)
);repeat.
);progn
(progn ;无"A1,AA1"块时，亮显选择集
(setq con-pt (GetSSBoundingbox ss)) ;单个实体或选择集的最小包围框
;;; 亮显选择集
(repeat (setq cnt (sslength ss))
(redraw (ssname ss (setq cnt (1- cnt))) 3)
)
);progn
);if
);while
con-pt);defun
;;;----------------------------------------------------------
;;; 以下为上述程序要用到的子函数, 都来源于明经，部分稍有修改.
;;;----------------------------------------------------------
;功能：返回选择集包围盒
;参数: ss--选择集
;返回值：选择集所有实体做为整体的包围盒
;| (setq ssbox (GetSSBoundingbox (ssget)))
(command "._pline" "_non" (car ssbox) "_non" (list (caar ssbox) (cadadr ssbox))
"_non" (cadr ssbox) "_non" (list (caadr ssbox) (cadar ssbox)) "_c")
|;
(defun GetSSBoundingbox (sse / ss i ssn ll rr box ptlist ssbox)
(if (= 'ENAME (type sse))
(progn (setq ss (ssadd)) (ssadd sse ss))
(setq ss sse))
(if ss
(progn
(setq i -1)
(repeat (sslength ss)
(setq ssn (ssname ss (setq i (1+ i))))
(vla-GetBoundingBox (vlax-ename->vla-object ssn) 'll 'rr);得到对象的包围盒
(setq box (list (vlax-safearray->list ll) (vlax-safearray->list rr)))
(setq ptlist (append ptlist box))
)
(setq ssbox (mapcar '(lambda (x) (apply 'mapcar (cons x ptlist))) (list 'min 'max)))
)
)
)
;;; 中心点:
; (setq midpt (mapcar '(lambda (a b) (/ (+ a b) 2)) (car ssbox) (cadr ssbox)))
;;; 或:
; (setq midpt (apply 'mapcar (cons (function (lambda (a b) (/ (+ a b) 2))) ssbox)))
;;;---------------------------------------------------
;;;*****************************************
;; No.6-3 亮显选择集或对象(夹点不显示) 函数
;;;*****************************************
(defun ayEntSSHighLight(SSorEntName / oldGrips)
(setq oldGrips (getvar "Grips"))
(setvar "Grips" 0)
(cond
((= (type SSorEntName) 'PICKSET);选择集.
(sssetfirst nil SSorEntName)
);end_switch
((= (type SSorEntName) 'ENAME);单一实体.
(sssetfirst nil (ssadd SSorEntName (ssadd)))
);end_switch
);end_cond
(setvar "Grips" oldGrips)
);end_defun
;;;---------------------------------------------------
(princ)
测试图（R14格式）：
我调试了一下，发现是没跳出while循环的条件，跟sssetfirst没关吧？
页:
[1]