大家帮忙看下这个程序的思路是什么，因为有些函数没有

why1025 · 发表于 2014-1-12 22:35

why1025 · 发表于 2014-1-12 22:36

(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[F.栏选 C.框选 W.窗选 P.上一次选择 -.撤销]:")
(prompt "\n[F.栏选 C.框选 W.窗选 P.上一次选择]:")
)
(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[F.栏选 C.框选 W.窗选 P.上一次选择 -.撤销]取消撤销，继续添加:")
(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
)
)
)

(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[F.栏选 C.框选 W.窗选 P.上一次选择 -.撤销]:") 
    (prompt "\n[F.栏选 C.框选 W.窗选 P.上一次选择]:") 
    ) 
  (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[F.栏选 C.框选 W.窗选 P.上一次选择 -.撤销]取消撤销，继续添加:") 
               (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 
         ) 
    ) 
  )

why1025 · 发表于 2014-1-12 22:38

或者在此基础上把没有的函数补全，把函数完善了

edata · 发表于 2014-1-13 00:28

〖信·CAD〗工具箱全部源码公布 2012.03.20
http://bbs.mjtd.com/forum.php?mo ... &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))
)
)

账号		自动登录	找回密码
密码			注册

[提问] 大家帮忙看下这个程序的思路是什么，因为有些函数没有

相关帖子