几个整合的GetXXX用户输入函数

HLCAD · 发表于 2013-6-17 08:11:07

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

; =========================================================================================== ;
; Get a keyword from the user ;
; Var [STR/SYM] - GetXXX函数结果值存放到 (read(Var))/Var变量中 ;
; 如Var本身有值，则作为缺省值 ;
; GetXXX [SYM] - 'GetAngle、'GetDist、'GetInt、'GetKword、'GetReal、'GetString其中之一 ;
; init [LIST] - initget函数用，格式：(Bit整数 Keys[list of possible keywords]文本) ;
; 如 '(4 "Yes No")、'(nil "Yes No")、'("Yes No")、(4) ;
; Msg [STR] - query text 文本提示信息(要包含关键字信息) ;
; DefB [STR] - default keyword. 当Var有值且合法, 用Var值, 否则用DefB值 ;
; ------------------------------------------------------------------------------------------- ;
; (HLCAD-GetXXX nil 'GetAngle nil "输入度数" 90) ;不受Initge正负限制 ;
; (HLCAD-GetXXX nil "GetDist" 4 "输入距离(不许负值)" "必须输入") ;
; (HLCAD-GetXXX 'aaa 'GetInt 5 "输入距离(不许负值)" "必须输入正整数") ;
; (HLCAD-GetXXX 'aaa 'GetKWord '(1 "Yes No") "重定义块吗(Y/N)" "Y") ;必须输入 ;
; (HLCAD-GetXXX 'aaa 'GetString nil "输入任意字符" "默认字符") ;不受Initge影响 ;
; (HLCAD-GetXXX "" 'GetString nil "输入任意字符" "默认字符") ;不受Initge影响 ;
; (HLCAD-GetXXX "" 'Get-KWord '(1 "Yes No") "重定义块吗(Y/N)" "Y") ;错误的系统函数 ;
; =========================================================================================== ;
(defun HLCAD-GetXXX (Var GetXXX init Msg DefB / Def tmp pro-mpt res)
(vl-load-com)
;;; 处理—Var
(cond ((and Var (= (type Var) 'SYM))
(if (setq tmp (eval Var)) (setq Def tmp))
(setq Var (vl-symbol-name Var)) ;sym=>str.
)
((and Var (= (type Var) 'STR) (/= Var ""))
(if (setq tmp (eval (read Var))) (setq Def tmp))
)
(t (setq Var nil Def nil))
)
;;; 处理—GetXXX
(if (= (type GetXXX) 'SYM)
(setq GetXXX (vl-symbol-name GetXXX))) ;sym=>str.
(if (and GetXXX (= (type GetXXX) 'STR)
(setq tmp (car (atoms-family 1 (list GetXXX)))) ;检查函数是否已定义
(member tmp '("GETANGLE" "GETDIST" "GETINT" "GETKWORD" "GETREAL" "GETSTRING"))
)
(progn
(cond ;处理—Def
((= GetXXX "GETANGLE")
(setq Def (cond ((numberp Def) (/ (* Def 180.) pi))
((numberp DefB) DefB)
(t nil))))
((or (= GetXXX "GETDIST") (= GetXXX "GETREAL"))
(setq Def (cond ((numberp Def) Def)
((numberp DefB) DefB)
(t nil))))
((= GetXXX "GETINT")
(setq Def (cond ((= (type Def) 'INT) Def)
((= (type DefB)'INT) DefB)
(t nil))))
((or (= GetXXX "GETKWORD") (= GetXXX "GETSTRING"))
(setq Def (cond ((and (= (type Def) 'STR) (/= Def "")) Def)
((and (= (type DefB) 'STR) (/= DefB "")) DefB)
(t nil))))
)
(cond ;处理—Msg、Def及其组合
((and Msg (= (type Msg) 'STR)
(setq Msg (if (= (substr Msg 1 1) "\n") Msg (strcat "\n" Msg)))
nil))
((not (or (and Msg (= (type Msg) 'STR))
(setq Msg "\n输入值"))))
((and Def (= (type Def) 'INT))
(setq pro-mpt (strcat Msg "/<" (itoa Def) ">: ")))
((and Def (= (type Def) 'REAL))
(setq pro-mpt (strcat Msg "/<" (rtos Def 2) ">: ")))
((and Def (= (type Def) 'STR))
(setq pro-mpt (strcat Msg "/<" Def ">: ")))
((and (not Def) (= (type Msg) 'STR))
(setq pro-mpt (strcat Msg ": ")))
)
(if (not Def)
(setq logi 1)
(setq logi 0)
)
(cond ;处理—initget
((= getXXX "GETSTRING") nil) ;GetString 不需要 initge.
((and init (or (= (type init) 'INT) (= (type init) 'STR)))
(if (= (type init) 'INT)
(initget (logior logi init))
(initget logi init)
))
((and init (= (type init) 'LIST) (= (length init) 1)
(or (= (type (car init)) 'INT) (= (type (car init)) 'STR)))
(if (= (type (car init)) 'INT)
(initget (logior logi (car init)))
(initget logi (car init))
))
((and init (= (type init) 'LIST) (= (length init) 2)
(= (type (car init)) 'INT) (= (type (cadr init)) 'STR))
(initget (logior logi (car init)) (cadr init)))
)
;;;正式求用户输入值
(if (or (not (setq res (vl-catch-all-apply (read getxxx) (list pro-mpt))))
(= res "")) ;getstring专用
(if (= GetXXX "GETANGLE")
(setq res (/ (* Def pi) 180.))
(setq res Def)
))
(if Var (set (read Var) res))
) ;_progn
(progn
(princ "\n系统不支持的函数\"")
(princ GetXXX)
(princ "\"")
(setq res nil)
) ;_progn
) ;_if
res)
; =========================================================================================== ;

; =========================================================================================== ; 
; Get a keyword from the user                                                                 ; 
;  Var  [STR/SYM] - GetXXX函数结果值存放到 (read(Var))/Var变量中                              ; 
;                   如Var本身有值，则作为缺省值                                               ; 
;  GetXXX [SYM] - 'GetAngle、'GetDist、'GetInt、'GetKword、'GetReal、'GetString其中之一       ; 
;  init [LIST] - initget函数用，格式：(Bit整数 Keys[list of possible keywords]文本)           ; 
;                如 '(4 "Yes No")、'(nil "Yes No")、'("Yes No")、(4)                          ; 
;  Msg  [STR]  - query text 文本提示信息(要包含关键字信息)                                    ; 
;  DefB [STR]  - default keyword. 当Var有值且合法, 用Var值, 否则用DefB值                      ; 
; ------------------------------------------------------------------------------------------- ; 
; (HLCAD-GetXXX  nil 'GetAngle nil "输入度数" 90)                     ;不受Initge正负限制     ; 
; (HLCAD-GetXXX  nil "GetDist" 4 "输入距离(不许负值)" "必须输入")                             ; 
; (HLCAD-GetXXX 'aaa 'GetInt 5 "输入距离(不许负值)" "必须输入正整数")                         ; 
; (HLCAD-GetXXX 'aaa 'GetKWord '(1 "Yes No") "重定义块吗(Y/N)" "Y")   ;必须输入               ; 
; (HLCAD-GetXXX 'aaa 'GetString nil "输入任意字符" "默认字符")        ;不受Initge影响         ; 
; (HLCAD-GetXXX  ""  'GetString nil "输入任意字符" "默认字符")        ;不受Initge影响         ; 
; (HLCAD-GetXXX  ""  'Get-KWord '(1 "Yes No") "重定义块吗(Y/N)" "Y")  ;错误的系统函数         ; 
; =========================================================================================== ; 
(defun HLCAD-GetXXX (Var GetXXX init Msg DefB / Def tmp pro-mpt res) 
  (vl-load-com) 
;;; 处理—Var 
  (cond ((and  Var (= (type Var) 'SYM)) 
   (if (setq tmp (eval Var)) (setq Def tmp)) 
   (setq Var (vl-symbol-name Var)) ;sym=>str. 
   ) 
  ((and  Var (= (type Var) 'STR) (/= Var "")) 
   (if (setq tmp (eval (read Var))) (setq Def tmp)) 
   ) 
  (t (setq Var nil   Def nil)) 
  ) 
;;; 处理—GetXXX 
  (if (= (type GetXXX) 'SYM) 
    (setq GetXXX (vl-symbol-name GetXXX))) ;sym=>str. 
  (if (and GetXXX (= (type GetXXX) 'STR) 
     (setq tmp (car (atoms-family 1 (list GetXXX)))) ;检查函数是否已定义 
     (member tmp '("GETANGLE" "GETDIST" "GETINT" "GETKWORD" "GETREAL" "GETSTRING")) 
     ) 
    (progn 
      (cond ;处理—Def 
  ((= GetXXX "GETANGLE") 
   (setq Def (cond ((numberp Def) (/ (* Def 180.) pi)) 
       ((numberp DefB) DefB) 
       (t nil)))) 
  ((or (= GetXXX "GETDIST") (= GetXXX "GETREAL")) 
   (setq Def (cond ((numberp Def)  Def) 
       ((numberp DefB) DefB) 
       (t nil)))) 
  ((= GetXXX "GETINT") 
   (setq Def (cond ((= (type Def) 'INT) Def) 
       ((= (type DefB)'INT) DefB) 
       (t nil)))) 
  ((or (= GetXXX "GETKWORD") (= GetXXX "GETSTRING")) 
   (setq Def (cond ((and (= (type Def)  'STR) (/= Def  "")) Def) 
       ((and (= (type DefB) 'STR) (/= DefB "")) DefB) 
       (t nil)))) 
  ) 
      (cond ;处理—Msg、Def及其组合 
  ((and Msg (= (type Msg) 'STR) 
        (setq Msg (if (= (substr Msg 1 1) "\n") Msg (strcat "\n" Msg))) 
        nil)) 
  ((not (or (and Msg (= (type Msg) 'STR)) 
      (setq Msg "\n输入值")))) 
  ((and Def (= (type Def) 'INT)) 
   (setq pro-mpt (strcat Msg "/<" (itoa Def) ">: "))) 
  ((and Def (= (type Def) 'REAL)) 
   (setq pro-mpt (strcat Msg "/<" (rtos Def 2) ">: "))) 
  ((and Def (= (type Def) 'STR)) 
   (setq pro-mpt (strcat Msg "/<" Def ">: "))) 
  ((and (not Def) (= (type Msg) 'STR)) 
   (setq pro-mpt (strcat Msg ": "))) 
  ) 
      (if (not Def) 
  (setq logi 1) 
  (setq logi 0) 
  ) 
      (cond ;处理—initget 
  ((= getXXX "GETSTRING") nil) ;GetString 不需要 initge. 
  ((and init (or (= (type init) 'INT) (= (type init) 'STR))) 
   (if (= (type init) 'INT) 
     (initget (logior logi init)) 
     (initget logi init) 
     )) 
  ((and init (= (type init) 'LIST) (= (length init) 1) 
        (or (= (type (car init)) 'INT) (= (type (car init)) 'STR))) 
   (if (= (type (car init)) 'INT) 
     (initget (logior logi (car init))) 
     (initget logi (car init)) 
     )) 
  ((and init (= (type init) 'LIST) (= (length init) 2) 
        (= (type (car init)) 'INT) (= (type (cadr init)) 'STR)) 
   (initget (logior logi (car init)) (cadr init))) 
  ) 
;;;正式求用户输入值 
      (if (or (not (setq res (vl-catch-all-apply (read getxxx) (list pro-mpt)))) 
        (= res "")) ;getstring专用 
  (if (= GetXXX "GETANGLE") 
    (setq res (/ (* Def pi) 180.)) 
    (setq res Def) 
    )) 
      (if Var (set (read Var) res)) 
      ) ;_progn 
    (progn 
      (princ "\n系统不支持的函数\"") 
      (princ GetXXX) 
      (princ "\"") 
      (setq res nil) 
      ) ;_progn 
    ) ;_if 
  res) 
; =========================================================================================== ;

q3_2006 · 发表于 2013-6-17 08:15:44

这个有用，要收藏！

xiaoyuzj503 · 发表于 2013-6-17 09:54:39

好东西，收藏了。谢谢分享{:soso_e113:}

ysq101 · 发表于 2013-6-17 21:09:39

可怜的我还没学到~~~~~~~看到金子也不知道是好东西

pengfei2010 · 发表于 2013-6-26 10:11:41

不知道有什么优点呢

HLCAD · 发表于 2013-6-26 13:59:48

pengfei2010 发表于 2013-6-26 10:11
不知道有什么优点呢

以GetInt为例，假定原变量AAA的值为8，需要用户确认是否是8，如果是8，则直接按确认键即可，如不是，可输入其它的整数，结果仍存入变量AAA中，应用本程序则只要一行：
(HLCAD-GetXXX 'aaa 'GetInt 5 "输入整数(不许负值)" 6)
如果用传统的，至少需要3行以上，如遇条件判断,则需更多。

pengfei2010 · 发表于 2013-6-26 18:28:47

HLCAD 发表于 2013-6-26 13:59
以GetInt为例，假定原变量AAA的值为8，需要用户确认是否是8，如果是8，则直接按确认键即可，如不是，可输 ...

哦，我时间看看您的源码，感觉很不错

海盗曹 · 发表于 2015-4-29 09:38:13

好东西啊，学习了

显示全部楼层 · 发表于 2015-10-24 09:14:01

提示: 作者被禁止或删除内容自动屏蔽

nnzj@163.com · 发表于 2015-11-7 01:09:39

好东西啊，学习了

yoyoho · 发表于 2016-9-14 09:29:31

好东西啊，学习喔!!!

凝思 · 发表于 2017-3-21 10:48:35

确实是难得好帖啊，顶先

神秘将军 · 发表于 2017-4-14 09:30:35

太好用了，谢谢分享

yjch · 发表于 2017-4-14 16:52:12

啥也不说了，好好学习天天向上！

wang112358 · 发表于 2019-1-7 15:57:44

简洁实用，感谢分享

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

恒等式发muo 该用户已被删除	发表于 2015-10-24 09:14:01 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽
恒等式发muo 该用户已被删除	论坛插件加载方法发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
	回复支持反对使用道具举报

[选择集] 几个整合的GetXXX用户输入函数

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

相关帖子

点评

点评