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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › 源码共享 › 函数：不用回车的超级GETPOINT
返回列表 发新帖
查看: 68|回复: 2

函数：不用回车的超级GETPOINT

[复制链接]
尘缘一生
发表于 2 小时前 | 显示全部楼层 |阅读模式
这个问题，继续完善下去：

我曾经发过一个帖子，但是不理想
http://bbs.mjtd.com/thread-193171-1-1.html
本次继续对这个问题，换思路写写，希望大家继续研究、探索
  2. ;Modify By SLdesign V3.0 尘缘一生 QQ:15290049
  3. ;不用回车的超级key&getpoint(非循环按键)-----(一级)-----
  4. ;ms前缀提示 ks键位提示
  5. ;返回表:(点  Key) 点击时 key=t
  6. ;(key_getpoint "\n 取点.方式->" "[实体(A)/钢筋砼(B)](左键,回车,右键,空格->取点)")
  7. (defun key_getpoint (ms ks / e_lst f8 f3 loop bb keylis p00 key p2 pt)
  8.   (setq ks (t-string-subst (slmsg "/正交(F8)/扑捉(F3)]" "/タユ(F8)/汲(F3)]" "/Orth(F8)/Osnap(F3)]") "]" ks))
  9.   (setq e_lst (sysvar '("OSMODE" "ORTHOMODE"))
  10.     keylis '((2 65) (2 97) ;A a
  11.               (2 66) (2 98) ;B b
  12.               (2 67) (2 99) ;C c
  13.               (2 100) (2 68) ;D d
  14.               (2 69) (2 101) ;E e
  15.               (2 70) (2 102) ;F f
  16.               (2 71) (2 103) ;G g
  17.               (2 72) (2 104) ;H h
  18.               (2 73) (2 105) ;I i
  19.               (2 74) (2 106) ;J j
  20.               (2 75) (2 107) ;K k
  21.               (2 76) (2 108) ;L l
  22.               (2 77) (2 109) ;M m
  23.               (2 78) (2 110) ;N n
  24.               (2 79) (2 111) ;O o
  25.               (2 80) (2 112) ;P p
  26.               (2 81) (2 113) ;Q q
  27.               (2 82) (2 114) ;Q q
  28.               (2 83) (2 115) ;S s
  29.               (2 84) (2 116) ;T t
  30.               (2 85) (2 117) ;U u
  31.               (2 86) (2 118) ;V v
  32.               (2 87) (2 119) ;W w
  33.               (2 88) (2 120) ;X x
  34.               (2 89) (2 121) ;Y y
  35.               (2 90) (2 122) ;Z z
  36.               (2 48) ;0
  37.               (2 49) ;1
  38.               (2 50) ;2
  39.               (2 51) ;3
  40.               (2 52) ;4
  41.               (2 53) ;5
  42.               (2 54) ;6
  43.               (2 55) ;7
  44.               (2 56) ;8
  45.               (2 57) ;9
  46.               (2 96) (2 126) ;`~键
  47.               (2 9) ;;table 键
  48.               (2 45) ;-
  49.               (2 43) (2 61);+=
  50.             )
  51.     loop t f8 (getvar "ORTHOMODE") f3 (getvar "OSMODE") p2 (cadr (grread 5))
  52.   )
  53.   (prompt (strcat ms ks))
  54.   (while loop
  55.     (setq bb (grread t 15 2) p00 (cadr bb))
  56.     (cond
  57.       ((equal bb '(2 6));F3切换捕捉开关
  58.         (cond
  59.           ((and (< f3 16384) (/= f3 0))
  60.             (setq f3 (+ f3 16384))
  61.             (prompt (slmsg "\n <对象捕捉 关>" "\n <癸禜 闽>" "\n <OSnap Off>"))
  62.           )
  63.           ((or (= f3 0) (>= f3 16384))
  64.             (setq f3 16383 f8 0)
  65.             (setvar "ORTHOMODE" f8)
  66.             (prompt (slmsg "\n <对象捕捉 开>" "\n <癸禜 秨>" "\n <OSnap On>"))
  67.           )
  68.         )
  69.         (setvar "OSMODE" f3) (redraw)
  70.       )   
  71.       ((equal bb '(2 15))    ;F8切换正交开关
  72.         (if (= f8 0)
  73.           (progn
  74.             (setq f8 1)
  75.             (if (and (< f3 16384) (/= f3 0))
  76.               (progn (setq f3 (+ f3 16384)) (setvar "OSMODE" f3))
  77.             )
  78.             (prompt (slmsg "\n <正交 开>" "\n <タユ 秨>" "\n <Orth open>"))
  79.           )
  80.           (progn (setq f8 0) (prompt (slmsg "\n <正交 关>" "\n <タユ 闽>" "\n <Orth off>")))
  81.         )
  82.         (setvar "ORTHOMODE" f8) (redraw)
  83.       )
  84.       ((= (car bb) 5)
  85.         (redraw)
  86.         (setq pt p00)
  87.         (if (= f8 1)
  88.           (if (< (abs (- (car p2) (car p00))) (abs (- (cadr p2) (cadr p00))))
  89.             (setq pt (list (car p2) (cadr p00)))
  90.             (setq pt (list (car p00) (cadr p2)))
  91.           )
  92.         )
  93.         (if (and (<= f3 16384) (> f3 0))
  94.           (setq pt (slosnappt nil pt))
  95.           (slslx pt 0)
  96.         )
  97.         (setq p00 pt)
  98.       )
  99.       ((member bb keylis)
  100.         (if (= (cadr bb) 9)
  101.           (setq key "TAB")
  102.           (setq key (strcase (chr (cadr bb))))
  103.         )
  104.         (setq p00 pt loop nil)
  105.       )
  106.       ((or (member bb '((2 13))) (= (car bb) 3) (member (car bb) '(11 25)) (member bb '((2 32))));;左键、回车、右键、空格,缺省退出
  107.         (setq p00 pt key t loop nil)
  108.       )
  109.     )
  110.   )
  111.   (redraw)
  112.   (mapcar 'eval e_lst)
  113.   (list p00 key)
  114. )


SLdesign 3.0  三领设计下载如下：

通过网盘分享的文件：三领设计
链接: https://pan.baidu.com/s/1iMwJD68IDQpbDfmGsdoQ-A?pwd=inxs 提取码: inxs

评分

参与人数 1明经币 +1 收起 理由
tranque + 1 很给力!

查看全部评分

回复

使用道具 举报

tranque
发表于 1 小时前 | 显示全部楼层
让元宝AI给陈总的代码加了下注释和代码总结


总结：
这是一个高级的点取函数，主要特点包括：

智能输入：支持鼠标点取和键盘快捷键两种输入方式
实时反馈：光标移动时显示临时图形辅助定位
状态切换：F3切换对象捕捉，F8切换正交模式
多键支持：支持字母、数字、符号等多种快捷键
自动恢复：函数结束时自动恢复之前的系统设置
简洁交互：减少命令行文字显示，提供更直观的操作体验
这个函数常用于需要快速点选位置同时可能需要进行模式切换的CAD操作场景


注释版：
  1. (vl-load-com)  ;; 加载Visual LISP扩展功能，支持ActiveX对象操作

  3. ;==============================================================
  4. ; 函数名称：key_getpoint - 智能点取函数（支持键盘快捷键）
  5. ; 开发信息：Modify By SLdesign V3.0 尘缘一生 QQ:15290049
  6. ; 功能描述：不用回车的超级key&getpoint(非循环按键)-----(一级)-----
  7. ;           实现带键盘快捷键的点取功能，提高操作效率
  8. ; 参数说明：
  9. ;   ms - 主提示字符串（ms前缀提示）
  10. ;   ks - 按键提示字符串（ks键位提示）
  11. ; 返回值：返回表点 Key)
  12. ;          点击时 key=t，按快捷键时 key=对应的键名
  13. ; 使用示例：
  14. ;   (key_getpoint "\n 取点.方式->" "[实体(A)/钢筋砼(B)](左键,回车,右键,空格->取点)")
  15. ;==============================================================

  17. (defun key_getpoint (ms ks / e_lst f8 f3 loop bb keylis p00 key p2 pt)
  18.   ;; 初始化部分 ================================================
  19.   
  20.   ; 在按键提示字符串末尾添加正交和捕捉的状态提示
  21.   ; t-string-subst函数用于字符串替换，支持多语言显示
  22.   (setq ks (t-string-subst
  23.             (slmsg "/正交(F8)/捕捉(F3)]" "/タユ(F8)/汲(F3)]" "/Orth(F8)/Osnap(F3)]")
  24.             "]" ks))
  25.   
  26.   ; 保存当前的系统变量设置，函数结束时恢复
  27.   ; sysvar函数用于保存指定的系统变量值
  28.   (setq e_lst (sysvar '("OSMODE" "ORTHOMODE"))
  29.    
  30.     ; 定义可识别的快捷键列表
  31.     ; 格式：((类型码 键值) ...) 其中类型码2表示键盘输入
  32.     keylis '((2 65) (2 97)    ; A a
  33.               (2 66) (2 98)    ; B b
  34.               (2 67) (2 99)    ; C c
  35.               (2 100) (2 68)   ; D d
  36.               (2 69) (2 101)   ; E e
  37.               (2 70) (2 102)   ; F f
  38.               (2 71) (2 103)   ; G g
  39.               (2 72) (2 104)   ; H h
  40.               (2 73) (2 105)   ; I i
  41.               (2 74) (2 106)   ; J j
  42.               (2 75) (2 107)   ; K k
  43.               (2 76) (2 108)   ; L l
  44.               (2 77) (2 109)   ; M m
  45.               (2 78) (2 110)   ; N n
  46.               (2 79) (2 111)   ; O o
  47.               (2 80) (2 112)   ; P p
  48.               (2 81) (2 113)   ; Q q
  49.               (2 82) (2 114)   ; R r
  50.               (2 83) (2 115)   ; S s
  51.               (2 84) (2 116)   ; T t
  52.               (2 85) (2 117)   ; U u
  53.               (2 86) (2 118)   ; V v
  54.               (2 87) (2 119)   ; W w
  55.               (2 88) (2 120)   ; X x
  56.               (2 89) (2 121)   ; Y y
  57.               (2 90) (2 122)   ; Z z
  58.               (2 48)           ; 0
  59.               (2 49)           ; 1
  60.               (2 50)           ; 2
  61.               (2 51)           ; 3
  62.               (2 52)           ; 4
  63.               (2 53)           ; 5
  64.               (2 54)           ; 6
  65.               (2 55)           ; 7
  66.               (2 56)           ; 8
  67.               (2 57)           ; 9
  68.               (2 96) (2 126)   ; `~键
  69.               (2 9)            ; TAB键
  70.               (2 45)           ; - 减号键
  71.               (2 43) (2 61)    ; += 等号键
  72.             )
  73.    
  74.     ; 初始化循环控制变量和状态变量
  75.     loop t          ; 循环控制标志，初始为真（t）
  76.     f8 (getvar "ORTHOMODE")  ; 保存当前正交模式状态
  77.     f3 (getvar "OSMODE")     ; 保存当前对象捕捉模式状态
  78.     p2 (cadr (grread 5))     ; 预读鼠标位置（grread 5表示非阻塞读取）
  79.   )
  80.   
  81.   ; 在命令行显示提示信息
  82.   (prompt (strcat ms ks))
  83.   
  84.   ;; 主循环 ====================================================
  85.   (while loop
  86.     ; 等待用户输入：grread参数说明：
  87.     ;   t - 跟踪光标移动
  88.     ;   15 - 光标跟踪间隔（毫秒）
  89.     ;   2 - 返回光标坐标（非零值）
  90.     (setq bb (grread t 15 2)   ; bb包含输入类型和值
  91.           p00 (cadr bb))       ; p00保存当前的坐标点
  92.    
  93.     ; 条件判断：根据不同的输入类型执行相应操作
  94.     (cond
  95.       ;; F3键处理 - 切换对象捕捉开关 ===========================
  96.       ((equal bb '(2 6))  ; 2表示键盘输入，6是F3键的键值
  97.         (cond
  98.           ; 此处条件判断不完整，可能是代码有误，但保持原样
  99.           ((and (" "\n " "\n "))
  100.           )
  101.           ; 如果当前捕捉关闭或处于高级捕捉模式，则开启常规捕捉
  102.           ((or (= f3 0) (>= f3 16384))
  103.             (setq f3 16383  ; 设置为常用捕捉模式组合
  104.                   f8 0)     ; 关闭正交模式
  105.             (setvar "ORTHOMODE" f8)  ; 应用正交模式设置
  106.             (prompt (slmsg "\n " "\n " "\n "))  ; 显示状态提示
  107.           )
  108.         )
  109.         (setvar "OSMODE" f3)  ; 应用捕捉模式设置
  110.         (redraw)  ; 重绘图面，清除临时图形
  111.       )   
  112.       
  113.       ;; F8键处理 - 切换正交模式开关 ===========================
  114.       ((equal bb '(2 15))  ; 2表示键盘输入，15是F8键的键值
  115.         (if (= f8 0)  ; 如果当前正交关闭
  116.           (progn
  117.             (setq f8 1)  ; 开启正交模式
  118.             ; 此处条件判断不完整，可能是代码有误
  119.             (if (and (" "\n " "\n "))
  120.             )
  121.           )
  122.           (progn  ; 如果当前正交开启
  123.             (setq f8 0)  ; 关闭正交模式
  124.             (prompt (slmsg "\n " "\n " "\n "))  ; 显示状态提示
  125.           )
  126.         )
  127.         (setvar "ORTHOMODE" f8)  ; 应用正交模式设置
  128.         (redraw)  ; 重绘图面
  129.       )
  130.       
  131.       ;; 鼠标移动处理 - 类型5表示光标移动 ======================
  132.       ((= (car bb) 5)
  133.         (redraw)  ; 清除之前的临时图形
  134.         (setq pt p00)  ; 保存当前鼠标位置
  135.         
  136.         ; 如果正交模式开启
  137.         (if (= f8 1)
  138.           ; 此处条件判断不完整，可能是代码有误
  139.           (if ( f3 0))
  140.           ; 应用对象捕捉到当前点
  141.           (setq pt (slosnappt nil pt))
  142.         )
  143.         ; 绘制临时图形（可能是十字线或预览图形）
  144.         (slslx pt 0)
  145.         (setq p00 pt)  ; 更新当前点坐标
  146.       )
  147.       
  148.       ;; 快捷键处理 - 检查是否按下了定义的快捷键 ===============
  149.       ((member bb keylis)  ; 检查输入是否在快捷键列表中
  150.         ; 处理TAB键特殊情况
  151.         (if (= (cadr bb) 9)  ; 9是TAB键的键值
  152.           (setq key "TAB")    ; 特殊处理TAB键
  153.           (setq key (strcase (chr (cadr bb))))  ; 将键值转换为大写字符
  154.         )
  155.         (setq p00 pt    ; 保存当前点
  156.               loop nil)  ; 退出循环
  157.       )
  158.       
  159.       ;; 确认操作处理 - 左键、回车、右键、空格等 ==============
  160.       ((or (member bb '((2 13)))   ; 回车键
  161.            (= (car bb) 3)          ; 鼠标右键
  162.            (member (car bb) '(11 25))  ; 其他确认键
  163.            (member bb '((2 32)))   ; 空格键
  164.       )  
  165.         (setq p00 pt    ; 保存当前点
  166.               key t     ; 设置key为t，表示是点击确认
  167.               loop nil) ; 退出循环
  168.       )
  169.     )
  170.   )
  171.   
  172.   ;; 清理和返回 ================================================
  173.   (redraw)  ; 最终重绘，清除所有临时图形
  174.   
  175.   ; 恢复之前保存的系统变量设置
  176.   ; mapcar 'eval 逐个执行保存的恢复命令
  177.   (mapcar 'eval e_lst)
  178.   
  179.   ; 返回结果：(点坐标 按键标识)
  180.   (list p00 key)
  181. )


回复 支持 反对

使用道具 举报

qifeifei
发表于 1 小时前 | 显示全部楼层
  2. (defun key_getpoint (ms ks / e_lst f8 f3 loop bb keylis p00 key p2 pt)

  4.   ;; 替换提示文本
  5.   (setq ks (t-string-subst
  6.             (slmsg "/正交(F8)/扑捉(F3)]"
  7.                    "/タユ(F8)/汲(F3)]"
  8.                    "/Orth(F8)/Osnap(F3)]")
  9.             "]" ks))

  11.   ;; 备份系统变量
  12.   (setq e_lst (sysvar '("OSMODE" "ORTHOMODE")))

  14.   ;; 所有按键列表（修复语法）
  15.   (setq keylis
  16.         '((2 65) (2 97)   ; A a
  17.           (2 66) (2 98)   ; B b
  18.           (2 67) (2 99)
  19.           (2 68) (2 100)
  20.           (2 69) (2 101)
  21.           (2 70) (2 102)
  22.           (2 71) (2 103)
  23.           (2 72) (2 104)
  24.           (2 73) (2 105)
  25.           (2 74) (2 106)
  26.           (2 75) (2 107)
  27.           (2 76) (2 108)
  28.           (2 77) (2 109)
  29.           (2 78) (2 110)
  30.           (2 79) (2 111)
  31.           (2 80) (2 112)
  32.           (2 81) (2 113)
  33.           (2 82) (2 114)
  34.           (2 83) (2 115)
  35.           (2 84) (2 116)
  36.           (2 85) (2 117)
  37.           (2 86) (2 118)
  38.           (2 87) (2 119)
  39.           (2 88) (2 120)
  40.           (2 89) (2 121)
  41.           (2 90) (2 122)
  42.           (2 48) (2 49) (2 50) (2 51) (2 52)
  43.           (2 53) (2 54) (2 55) (2 56) (2 57)
  44.           (2 96) (2 126)
  45.           (2 9)     ; TAB
  46.           (2 45)    ; -
  47.           (2 43) (2 61))) ; + and =

  49.   (setq loop t
  50.         f8 (getvar "ORTHOMODE")
  51.         f3 (getvar "OSMODE")
  52.         p2 (cadr (grread 5)))

  54.   (prompt (strcat ms ks))

  56.   (while loop
  57.     (setq bb  (grread t 15 2)
  58.           p00 (cadr bb))

  60.     (cond
  61.       ;; ---------------- F3 捕捉 --------------------
  62.       ((and (= (car bb) 2) (= (cadr bb) 6))
  63.        (if (and (< f3 16384) (/= f3 0))
  64.          (progn
  65.            (setq f3 (+ f3 16384))
  66.            (prompt (slmsg "\n <对象捕捉 关>"
  67.                            "\n <癸禜 闽>"
  68.                            "\n <OSnap Off>")))
  69.          (progn
  70.            (setq f3 16383  f8 0)
  71.            (setvar "ORTHOMODE" f8)
  72.            (prompt (slmsg "\n <对象捕捉 开>"
  73.                            "\n <癸禜 秨>"
  74.                            "\n <OSnap On>"))))
  75.        (setvar "OSMODE" f3) (redraw))

  77.       ;; ---------------- F8 正交 --------------------
  78.       ((and (= (car bb) 2) (= (cadr bb) 15))
  79.        (if (= f8 0)
  80.          (progn
  81.            (setq f8 1)
  82.            (if (and (< f3 16384) (/= f3 0))
  83.              (setq f3 (+ f3 16384)))
  84.            (setvar "OSMODE" f3)
  85.            (prompt (slmsg "\n <正交 开>"
  86.                            "\n <タユ 秨>"
  87.                            "\n <Orth open>")))
  88.          (progn
  89.            (setq f8 0)
  90.            (prompt (slmsg "\n <正交 关>"
  91.                            "\n <タユ 闽>"
  92.                            "\n <Orth off>"))))
  93.        (setvar "ORTHOMODE" f8) (redraw))

  95.       ;; ---------------- 鼠标移动 --------------------
  96.       ((= (car bb) 5)
  97.        (redraw)
  98.        (setq pt p00)
  99.        ;; 正交
  100.        (if (= f8 1)
  101.          (setq pt (if (< (abs (- (car p2) (car p00)))
  102.                          (abs (- (cadr p2) (cadr p00))))
  103.                      (list (car p2)  (cadr p00))
  104.                      (list (car p00) (cadr p2)))))

  106.        ;; 捕捉
  107.        (if (and (<= f3 16384) (> f3 0))
  108.          (setq pt (slosnappt nil pt))
  109.          (slslx pt 0))

  111.        (setq p00 pt))

  113.       ;; ---------------- 键盘字母/数字 --------------------
  114.       ((vl-some '(lambda (x) (equal x bb)) keylis)
  115.        (setq key (if (= (cadr bb) 9)
  116.                    "TAB"
  117.                    (strcase (chr (cadr bb)))))
  118.        (setq p00 pt loop nil))

  120.       ;; ---------------- 退出（左键/回车/右键/空格） --------------------
  121.       ((or
  122.         (and (= (car bb) 2) (= (cadr bb) 13)) ; 回车
  123.         (= (car bb) 3)                       ; 右键
  124.         (member (car bb) '(11 25))
  125.         (and (= (car bb) 2) (= (cadr bb) 32)) ; 空格
  126.         (= (car bb) 3))
  127.        (setq p00 pt key t loop nil))
  128.     )
  129.   )

  131.   (redraw)
  132.   (mapcar 'eval e_lst)
  133.   (list p00 key)
  134. )
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-11-24 13:45 , Processed in 0.196089 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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