[LISP函数]：一触即发的选项

lyy

;;一触即发的选项[pro-提示 lst-关键字列表 def-缺省关键字]
(defun yad-getkword(pro lst def / kw val)
  (setq lst (apply 'append (mapcar '(lambda(e) (list (ascii (strcase e)) (ascii (strcase e T)))) lst))
        def (ascii def)
  )
  (prompt pro)
  (while (not (and (setq kw (grread nil) val (car kw) kw (cadr kw))
                   (member val '(2 11 25))
                   (if (or (= val 25) (and (= val 11) (= kw 0)) (member kw '(13 32)))
                     (setq kw def)
                     (member kw lst)
                   )
              )
         )
  )
  (strcase (vl-list->string (list kw)))
)
;;例1：(yad-getkword "\n输入选项[A 直线/B 圆弧/C 圆]：<A>" '("A" "B" "C") "a")
;;例2：(yad-getkword "\n输入选项[A 直线/B 圆弧/C 圆]：<退出>" '("a" "b" "c") "X")

aeo

2. 
   
3. ;;;[say-提示 key-关键字列表 def-缺省关键字 control-为T时不能空退出(没def时)]
   
4. (defun getkword:(say key def control / a b c how is return)
   
5. (if(listp key)(setq key(mapcar 'strcase key))(setq key(list(strcase key))))
   
6. (prompt say)
   
7. (setq how t return nil)
   
8. (while(and how(setq is(grread)))
   
9.    (setq a(car is) b(cadr is))
   
10.    (cond((and(= a 2)(member(setq c(strcase(chr b)))key))(setq return c how nil))
    
11.         ((member is '((2 13)(2 32)(11 0)))
    
12.           (if def(setq return(strcase def) how nil)         ;;有缺省就可以退出了
    
13.                  (if control(princ(strcat"\n不能为空,重新输入!"say))  ;;没缺省,看能不能退出
    
14.                             (setq how nil)
    
15.                  )
    
16.           )
    
17.         )
    
18.         (t (princ(strcat"\n重输!"say)))   ;;这行可以不要
    
19.   ))return
    
20. )
    
21. 
    
22. ;;;example:
    
23. ;;;(getkword: "\nA??,B!!,C$$[A]: " '("a""b""c") "A" nil)        ;;有缺省时,control随便
    
24. ;;;(getkword: "\nA??:" "a" "A" nil)                             ;;单个
    
25. ;;;(getkword: "\nA??,B!!,C$$(回车退出):" '("a""b""c") nil nil)  ;;回车返回nil
    
26. ;;;(getkword: "\nA??,B!!,C$$: " '("a""b""c") nil t)             ;;回车要求重输
    

<br /> ;;;[say-提示 key-关键字列表 def-缺省关键字 control-为T时不能空退出(没def时)]<br /> (defun getkword:(say key def control / a b c how is return)<br /> (if(listp key)(setq key(mapcar 'strcase key))(setq key(list(strcase key))))<br /> (prompt say)<br /> (setq how t return nil)<br /> (while(and how(setq is(grread)))<br />    (setq a(car is) b(cadr is))<br />    (cond((and(= a 2)(member(setq c(strcase(chr b)))key))(setq return c how nil))<br />         ((member is '((2 13)(2 32)(11 0)))<br />           (if def(setq return(strcase def) how nil)         ;;有缺省就可以退出了<br />                  (if control(princ(strcat"\n不能为空,重新输入!"say))  ;;没缺省,看能不能退出<br />                             (setq how nil)<br />                  )<br />           )<br />         )<br />         (t (princ(strcat"\n重输!"say)))   ;;这行可以不要<br />   ))return<br /> )<br /> <br /> ;;;example:<br /> ;;;(getkword: "\nA??,B!!,C$$[A]: " '("a""b""c") "A" nil)        ;;有缺省时,control随便<br /> ;;;(getkword: "\nA??:" "a" "A" nil)                             ;;单个<br /> ;;;(getkword: "\nA??,B!!,C$$(回车退出):" '("a""b""c") nil nil)  ;;回车返回nil<br /> ;;;(getkword: "\nA??,B!!,C$$: " '("a""b""c") nil t)             ;;回车要求重输<br />

zxmmelly

还没看懂，保存 先