设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › [原创][源码]整合多个GetXXX用户输入函数在一块
返回列表 发新帖
查看: 3603|回复: 6

[函数] [原创][源码]整合多个GetXXX用户输入函数在一块

[复制链接]
USER2128
发表于 2013-6-18 09:34:32 | 显示全部楼层 |阅读模式
本帖最后由 USER2128 于 2013-6-18 11:08 编辑

;;;整合多个GetXXX用户输入函数在一块
; ======================================================================================= ;
; 作者：HLCAD（USER2128），版本1.1，完工日期：2013.06.18，转载请保留本信息                ;
; 版本1.1 增加getpoint、getcorner 内容，纠正了1.0版本中的一些小错误            ;
; Get a keyword from the user                                                             ;
;  Var  [STR/SYM] - GetXXX函数结果值存放到 (read(Var))/Var变量中                          ;
;                   如Var本身有值，则作为缺省值                                           ;
;  GetXXX [SYM] - 'GetAngle、getorient、'GetDist、'GetInt、'GetKword、'GetReal、          ;
;                 'GetString、getpoint、getcorner 其中之一, 也可为字符如"GetAngle"        ;
;  init [LIST] - initget函数用，格式：(Bit整数 Keys[list of possible keywords]文本)       ;
;                如 '(4 "Yes No")、'(nil "Yes No")、'("Yes No")、(4) 、4、"Yes No"        ;
;  Msg  [STR]  - query text 文本提示信息(要包含关键字信息)                                ;
;  DefB [INT/REAL/STR/LIST]  - default keyword. 当Var有值且合法, 用Var值, 否则用DefB值    ;
;                             当GetXXX=getpoint、getcorner时, 要利用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  nil 'GetPoint  1   "请提供一点位" nil)               ;无起点, 必输       ;
; (HLCAD-GetXXX  nil 'GetCorner 1   "请提供一点位" nil)               ;错误，未供基点     ;
; (HLCAD-GetXXX 'aaa 'GetCorner nil "请提供一点位" '(0 0 0))          ;                   ;
; (HLCAD-GetXXX  ""  'Get-KWord '(1 "Yes No") "重定义块吗(Y/N)" "Y")  ;错误的系统函数     ;
; ======================================================================================= ;

复制代码
getxxx, 用户输入, 整合

本帖子中包含更多资源

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

x

评分

参与人数 2明经币 +2 金钱 +5 收起 理由
自贡黄明儒 + 1 很给力!
【KAIXIN】 + 1 + 5 赞一个!

查看全部评分

"觉得好，就打赏"
打赏
还没有人打赏，支持一下

相关帖子
回复

使用道具 举报

xiaoquansb
发表于 2013-6-18 12:04:35 | 显示全部楼层
顶一个，学习了

点评

wzg356
刚写错位置了......  发表于 2014-12-4 13:36
wzg356
今后不沙发了  发表于 2014-12-4 13:30

评分

参与人数 1明经币 +1 收起 理由
USER2128 + 1 谢谢鉴赏!

查看全部评分

回复 支持 反对

使用道具 举报

1993063
发表于 2013-6-18 16:10:47 | 显示全部楼层
先帖两个出来看看,
回复 支持 反对

使用道具 举报

USER2128
 楼主| 发表于 2013-6-19 07:44:30 | 显示全部楼层
1993063 发表于 2013-6-18 16:10
先帖两个出来看看,

;;;V1.0版现免费给大家，请多提宝贵意见。
  2. ; ======================================================================================= ;
  3. ; 作者：HLCAD（USER2128），版本1.0，完工日期：2013.06.16，转载请保留本信息
  4. ; Get a keyword from the user                                                             ;
  5. ;  Var  [STR/SYM] - GetXXX函数结果值存放到 (read(Var))/Var变量中                          ;
  6. ;                   如Var本身有值，则作为缺省值                                           ;
  7. ;  GetXXX [SYM] - 'GetAngle、'GetDist、'GetInt、'GetKword、'GetReal、'GetString其中之一   ;
  8. ;  init [LIST] - initget函数用，格式：(Bit整数 Keys[list of possible keywords]文本)       ;
  9. ;                如 '(4 "Yes No")、'(nil "Yes No")、'("Yes No")、(4)                      ;
  10. ;  Msg  [STR]  - query text 文本提示信息(要包含关键字信息)                                ;
  11. ;  DefB [STR]  - default keyword. 当Var有值且合法, 用Var值, 否则用DefB值                  ;
  12. ; --------------------------------------------------------------------------------------- ;
  13. ; (HLCAD-GetXXX  nil 'GetAngle nil "输入度数" 90)                     ;不受Initge正负限制 ;
  14. ; (HLCAD-GetXXX  nil "GetDist" 4 "输入距离(不许负值)" "必须输入")                         ;
  15. ; (HLCAD-GetXXX 'aaa 'GetInt 5 "输入距离(不许负值)" "必须输入正整数")                     ;
  16. ; (HLCAD-GetXXX 'aaa 'GetKWord '(1 "Yes No") "重定义块吗(Y/N)" "Y")   ;必须输入           ;
  17. ; (HLCAD-GetXXX 'aaa 'GetString nil "输入任意字符" "默认字符")        ;不受Initge影响     ;
  18. ; (HLCAD-GetXXX  ""  'GetString nil "输入任意字符" "默认字符")        ;不受Initge影响     ;
  19. ; (HLCAD-GetXXX  ""  'Get-KWord '(1 "Yes No") "重定义块吗(Y/N)" "Y")  ;错误的系统函数     ;
  20. ; ======================================================================================= ;
  21. (defun HLCAD-GetXXX (Var GetXXX init Msg DefB / Def tmp pro-mpt res)
  22.   (vl-load-com)
  23. ;;; 处理—Var
  24.   (cond ((and  Var (= (type Var) 'SYM))
  25.    (if (setq tmp (eval Var)) (setq Def tmp))
  26.    (setq Var (vl-symbol-name Var)) ;sym=>str.
  27.    )
  28.   ((and  Var (= (type Var) 'STR) (/= Var ""))
  29.    (if (setq tmp (eval (read Var))) (setq Def tmp))
  30.    )
  31.   (t (setq Var nil   Def nil))
  32.   )
  33. ;;; 处理—GetXXX
  34.   (if (= (type GetXXX) 'SYM)
  35.     (setq GetXXX (vl-symbol-name GetXXX))) ;sym=>str.
  36.   (if (and GetXXX (= (type GetXXX) 'STR)
  37.      (setq tmp (car (atoms-family 1 (list GetXXX)))) ;检查函数是否已定义
  38.      (member tmp '("GETANGLE" "GETDIST" "GETINT" "GETKWORD" "GETREAL" "GETSTRING"))
  39.      )
  40.     (progn
  41.       (cond ;处理—Def
  42.   ((= GetXXX "GETANGLE")
  43.    (setq Def (cond ((numberp Def) (/ (* Def 180.) pi))
  44.        ((numberp DefB) DefB)
  45.        (t nil))))
  46.   ((or (= GetXXX "GETDIST") (= GetXXX "GETREAL"))
  47.    (setq Def (cond ((numberp Def)  Def)
  48.        ((numberp DefB) DefB)
  49.        (t nil))))
  50.   ((= GetXXX "GETINT")
  51.    (setq Def (cond ((= (type Def) 'INT) Def)
  52.        ((= (type DefB)'INT) DefB)
  53.        (t nil))))
  54.   ((or (= GetXXX "GETKWORD") (= GetXXX "GETSTRING"))
  55.    (setq Def (cond ((and (= (type Def)  'STR) (/= Def  "")) Def)
  56.        ((and (= (type DefB) 'STR) (/= DefB "")) DefB)
  57.        (t nil))))
  58.   )
  59.       (cond ;处理—Msg、Def及其组合
  60.   ((and Msg (= (type Msg) 'STR)
  61.         (setq Msg (if (= (substr Msg 1 1) "\n") Msg (strcat "\n" Msg)))
  62.         nil))
  63.   ((not (or (and Msg (= (type Msg) 'STR))
  64.       (setq Msg "\n输入值"))))
  65.   ((and Def (= (type Def) 'INT))
  66.    (setq pro-mpt (strcat Msg "/<" (itoa Def) ">: ")))
  67.   ((and Def (= (type Def) 'REAL))
  68.    (setq pro-mpt (strcat Msg "/<" (rtos Def 2) ">: ")))
  69.   ((and Def (= (type Def) 'STR))
  70.    (setq pro-mpt (strcat Msg "/<" Def ">: ")))
  71.   ((and (not Def) (= (type Msg) 'STR))
  72.    (setq pro-mpt (strcat Msg ": ")))
  73.   )
  74.       (if (not Def)
  75.   (setq logi 1)
  76.   (setq logi 0)
  77.   )
  78.       (cond ;处理—initget
  79.   ((= getXXX "GETSTRING") nil) ;GetString 不需要 initge.
  80.   ((and init (or (= (type init) 'INT) (= (type init) 'STR)))
  81.    (if (= (type init) 'INT)
  82.      (initget (logior logi init))
  83.      (initget logi init)
  84.      ))
  85.   ((and init (= (type init) 'LIST) (= (length init) 1)
  86.         (or (= (type (car init)) 'INT) (= (type (car init)) 'STR)))
  87.    (if (= (type (car init)) 'INT)
  88.      (initget (logior logi (car init)))
  89.      (initget logi (car init))
  90.      ))
  91.   ((and init (= (type init) 'LIST) (= (length init) 2)
  92.         (= (type (car init)) 'INT) (= (type (cadr init)) 'STR))
  93.    (initget (logior logi (car init)) (cadr init)))
  94.   )
  95. ;;;正式求用户输入值
  96.       (if (or (not (setq res (vl-catch-all-apply (read getxxx) (list pro-mpt))))
  97.         (= res "")) ;getstring专用
  98.   (if (= GetXXX "GETANGLE")
  99.     (setq res (/ (* Def pi) 180.))
  100.     (setq res Def)
  101.     ))
  102.       (if Var (set (read Var) res))
  103.       ) ;_progn
  104.     (progn
  105.       (princ "\n系统不支持的函数"")
  106.       (princ GetXXX)
  107.       (princ """)
  108.       (setq res nil)
  109.       ) ;_progn
  110.     ) ;_if
  111.   res)
  112. ; ======================================================================================= ;

评分

参与人数 1明经币 +1 收起 理由
1993063 + 1 赞一个!

查看全部评分

回复 支持 反对

使用道具 举报

kry
发表于 2013-10-18 11:42:56 | 显示全部楼层
不错，留个记号
回复 支持 反对

使用道具 举报

sicky111
发表于 2013-10-22 09:39:05 | 显示全部楼层
不得不佩服楼主，牛。
回复 支持 反对

使用道具 举报

479274135
发表于 2024-1-12 21:23:56 来自手机 | 显示全部楼层
大佬出品必属精品呀，先收藏  好评。好久没逛论坛了
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-25 03:56 , Processed in 0.211839 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表