[LISP程序]：让GETPOINT,ENTSEL支持KW

snsj

[PHP]
多功能按键的GETPOINT和ENTSEL
;;;|多功能一键完成 ,支持捕捉            
;;;|在getpoint情况下支持按键            
;;;|kw:语言描述LST:支持按键列表'("A" "B")
;;;|def:回车或空格时的缺省值            
;;;|作者:SNSJ 2006.10.20                 
(defun apple-getpt (kw lst def / tf gd ch lst1 ptt p cor)
(setq cor(vla-get-AutoSnapMarkerColor(vla-get-drafting
   (vla-get-preferences(vlax-get-acad-object))))
        )
(princ kw)(setq tf 0)
(setq lst1(mapcar 'strcase lst))
(while tf
(setq gd(grread t 4 0))
(setq p(cadr gd))
(redraw)
(if(and(=(car gd)5)(/=(setq ptt(apple-grdsp p cor))nil))
  (setq p ptt)
  )
(cond((and(=(car gd)2)(member (setq ch(strcase(chr p)))lst1))
      (setq tf nil))
    ((or(= p 32)(= p 13))(setq tf nil ch def))
    ((and(=(car gd)3)(=(type p) 'LIST))(setq ch p tf nil))
    )
  )(redraw)
   ch  
  )
;;;|多功能一键完成                       
;;;|在ENTSEL情况下支持按键               
;;;|kw:语言描述LST:支持按键列表'("A" "B")
;;;|def:回车或空格时的缺省值            
;;;|作者:SNSJ 2006.10.20                 
(defun apple-enl (kw lst def / tf gd ch lst1 p)
(princ kw)(setq tf 0)
  (setq lst1(mapcar 'strcase lst))
  (while tf
  (setq gd(grread t 4 2))
  (setq p(cadr gd))
(cond((and(=(car gd)2)(member (setq ch(strcase(chr p)))lst1))
     (setq tf nil))
     ((or(= p 32)(= p 13))(setq tf nil ch def))
     ((and(=(car gd)3)(=(type p) 'LIST))(setq ch(nentselp p) tf nil))
     )
    )ch  
  )  )[/PHP]

snsj

测试:(apple-getpt "A/B/<GETPOINT>:" '("A" "B") nil)
测试:(apple-enl "A/B/<GETPOINT>:" '("A" "B") nil)

雨箭风刀

不错，模拟捕捉显示基本全了

lidejun_55

捕捉模拟不知道是怎么实现的，还有两点：1、F3不起作用，2、捕捉框的大小好像不能调整大小

阿_Q

不明白.用来做什么的啊.

jx2008

那还得研究一下greead函数怎么实现捕捉功能吧