大家帮忙看下这个程序的思路是什么，因为有些函数没有
大家帮忙看下这个程序的思路是什么，因为有些函数没有(defun EF:PickSet-ssget-key (lstKey ;关键字列表
sPrompt ;提示
lstFilter ;过滤
bLight ;高亮
b- ;接受 -
/
bEnd return ss gr ename i n
)
(setvar 'cmdecho 0)
(setq lstKey (mapcar 'ascii lstKey))
(if sPrompt
(prompt sPrompt)
(prompt "\n选择对象:")
)
(if b-
(prompt "\n:")
(prompt "\n:")
)
(setq return (ssadd))
(while (not bEnd)
(if bLight (EF:PickSet-Light return) (EF:PickSet-UnLight return))
(setq gr (grread T 15 2))
(cond ((or (equal gr '(2 32)) ;点击空格
(equal gr '(2 13)) ;点击回车
)
(setq bEnd T)
)
((and b- (equal gr '(2 45))) ; -
(if (setq ss (EF:PickSet-ssget-key nil "\n选择要取消的对象" lstFilter (not bLight) nil))
(progn
(prompt "\n取消撤销，继续添加:")
(setq i -1 n (sslength ss))
(while (< (setq i (1+ i)) n)
(setq ename (ssname ss i))
(setq return (ssdel ename (ssadd ename return)))
)
)
)
)
((or (equal gr '(2 80)) ;P
(equal gr '(2 112)) ;p
)
(if (setq ss (if lstFilter (ssget "P" lstFilter) (ssget "P")))
(setq return (EF:PickSet-Join ss return))
)
)
((or (equal gr '(2 80)) ;F
(equal gr '(2 102)) ;f
)
(if (setq pt (getpoint "\n输入栏选第一点"))
(progn
(setq ptList (list pt))
(while (setq pt (getpoint (car ptList) "下一点" ))
(setq ptList (cons pt ptlist))
(redraw)
(EF:Dwg-grdraw ptList -1)
)
(if (setq ss (if lstFilter
(ssget "F" ptList lstFilter)
(ssget "F" ptList)
)
)
(setq return (EF:PickSet-Join ss return))
);end if
(redraw)
)
);end if
)
((or (equal gr '(2 67)) ;C
(equal gr '(2 99)) ;c
)
(if (setq pt (getpoint "\n输入框选第一点"))
(progn
(setq ptList (list pt))
(while (setq pt (getpoint (car ptList) "下一点" ))
(setq ptList (cons pt ptlist))
(redraw)
(EF:Dwg-grdraw ptList -1)
)
(if (setq ss (if lstFilter
(ssget "CP" ptList lstFilter)
(ssget "CP" ptList)
)
)
(setq return (EF:PickSet-Join ss return))
);end if
(redraw)
)
);end if
)
((or (equal gr '(2 87)) ;W
(equal gr '(2 119)) ;w
)
(if (setq pt (getpoint "\n输入窗选第一点"))
(progn
(setq ptList (list pt))
(while (setq pt (getpoint (car ptList) "下一点" ))
(setq ptList (cons pt ptlist))
(redraw)
(EF:Dwg-grdraw ptList -1)
)
(if (setq ss (if lstFilter
(ssget "WP" ptList lstFilter)
(ssget "WP" ptList)
)
)
(setq return (EF:PickSet-Join ss return))
);end if
(redraw)
)
);end if
)
((= (car gr) 2) ;点击字母
(setq gr (cadr gr))
(if (member gr lstKey)
(setq return (chr gr)
bEnd T)
)
)
((= (car gr) 3) ;鼠标点击
(setq gr (cadr gr))
(if (setq ss (ssget gr lstFilter))
(setq return (EF:PickSet-Join ss return))
(progn
(if (setq pt (getcorner gr "选择对角点:"))
(progn
(if (>= (car gr) (car pt))
(setq ss (ssget "C" gr pt lstFilter))
(setq ss (ssget "W" gr pt lstFilter))
)
(if ss
(setq return (EF:PickSet-Join ss return))
)
)
)
(prompt "选择对象:")
)
)
)
((or (= (car gr) 25) (= (car gr) 11)) ;鼠标右击
(setq bEnd T)
)
);end cond
)
(if (and (equal (type return) 'PICKSET)
(/= (sslength return) 0)
)
(EF:PickSet-unLight return)
)
(cond ((= (type return) 'STR)
return
)
((and (= (type return) 'PICKSET)
(> (sslength return) 0)
)
return
)
)
) 或者在此基础上把没有的函数补全，把函数完善了 〖信·CAD〗工具箱 全部源码公布 2012.03.20
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=92550&fromuid=338795;ss高亮显示
(defun EF:PickSet-Light (ss / i)
(setq i 0)
(while (< i (sslength ss))
(redraw (ssname ss i) 3)
(setq i (1+ i))
)
)
;ss低亮显示
(defun EF:PickSet-unLight (ss / i)
(setq i 0)
(while (< i (sslength ss))
(redraw (ssname ss i) 4)
(setq i (1+ i))
)
)
;选择集并集
(defun EF:PickSet-Join (ss1 ;第一选择集
ss2 ;第二选择集
/ i n ename)
(setq i -1)
(setq n (sslength ss1))
(while (< (setq i (1+ i)) n)
(setq ss2 (ssadd (ssname ss1 i) ss2))
)
ss2
)
;在图形屏幕上绘制点表矢量
;lstPTList 点表
;color 矢量色彩-1 表示 异或颜色
(defun EF:Dwg-grdraw ( lstPTList color / )
(repeat (- (length lstPTList) 1)
(grdraw (car lstPTList) (cadr lstPTList) color )
(setq lstPTList (cdr lstPTList))
)
)
页:
[1]