函数：不用回车的超级GETPOINT
这个问题，继续完善下去：我曾经发过一个帖子，但是不理想
http://bbs.mjtd.com/thread-193171-1-1.html
本次继续对这个问题，换思路写写，希望大家继续研究、探索
;Modify By SLdesign V3.0 尘缘一生 QQ:15290049
;不用回车的超级key&getpoint(非循环按键)-----(一级)-----
;ms前缀提示 ks键位提示
;返回表:(点Key) 点击时 key=t
;(key_getpoint "\n 取点.方式->" "[实体(A)/钢筋砼(B)](左键,回车,右键,空格->取点)")
(defun key_getpoint (ms ks / e_lst f8 f3 loop bb keylis p00 key p2 pt)
(setq ks (t-string-subst (slmsg "/正交(F8)/扑捉(F3)]" "/タユ(F8)/汲(F3)]" "/Orth(F8)/Osnap(F3)]") "]" ks))
(setq e_lst (sysvar '("OSMODE" "ORTHOMODE"))
keylis '((2 65) (2 97) ;A a
(2 66) (2 98) ;B b
(2 67) (2 99) ;C c
(2 100) (2 68) ;D d
(2 69) (2 101) ;E e
(2 70) (2 102) ;F f
(2 71) (2 103) ;G g
(2 72) (2 104) ;H h
(2 73) (2 105) ;I i
(2 74) (2 106) ;J j
(2 75) (2 107) ;K k
(2 76) (2 108) ;L l
(2 77) (2 109) ;M m
(2 78) (2 110) ;N n
(2 79) (2 111) ;O o
(2 80) (2 112) ;P p
(2 81) (2 113) ;Q q
(2 82) (2 114) ;Q q
(2 83) (2 115) ;S s
(2 84) (2 116) ;T t
(2 85) (2 117) ;U u
(2 86) (2 118) ;V v
(2 87) (2 119) ;W w
(2 88) (2 120) ;X x
(2 89) (2 121) ;Y y
(2 90) (2 122) ;Z z
(2 48) ;0
(2 49) ;1
(2 50) ;2
(2 51) ;3
(2 52) ;4
(2 53) ;5
(2 54) ;6
(2 55) ;7
(2 56) ;8
(2 57) ;9
(2 96) (2 126) ;`~键
(2 9) ;;table 键
(2 45) ;-
(2 43) (2 61);+=
)
loop t f8 (getvar "ORTHOMODE") f3 (getvar "OSMODE") p2 (cadr (grread 5))
)
(prompt (strcat ms ks))
(while loop
(setq bb (grread t 15 2) p00 (cadr bb))
(cond
((equal bb '(2 6));F3切换捕捉开关
(cond
((and (< f3 16384) (/= f3 0))
(setq f3 (+ f3 16384))
(prompt (slmsg "\n <对象捕捉 关>" "\n <癸禜 闽>" "\n <OSnap Off>"))
)
((or (= f3 0) (>= f3 16384))
(setq f3 16383 f8 0)
(setvar "ORTHOMODE" f8)
(prompt (slmsg "\n <对象捕捉 开>" "\n <癸禜 秨>" "\n <OSnap On>"))
)
)
(setvar "OSMODE" f3) (redraw)
)
((equal bb '(2 15)) ;F8切换正交开关
(if (= f8 0)
(progn
(setq f8 1)
(if (and (< f3 16384) (/= f3 0))
(progn (setq f3 (+ f3 16384)) (setvar "OSMODE" f3))
)
(prompt (slmsg "\n <正交 开>" "\n <タユ 秨>" "\n <Orth open>"))
)
(progn (setq f8 0) (prompt (slmsg "\n <正交 关>" "\n <タユ 闽>" "\n <Orth off>")))
)
(setvar "ORTHOMODE" f8) (redraw)
)
((= (car bb) 5)
(redraw)
(setq pt p00)
(if (= f8 1)
(if (< (abs (- (car p2) (car p00))) (abs (- (cadr p2) (cadr p00))))
(setq pt (list (car p2) (cadr p00)))
(setq pt (list (car p00) (cadr p2)))
)
)
(if (and (<= f3 16384) (> f3 0))
(setq pt (slosnappt nil pt))
(slslx pt 0)
)
(setq p00 pt)
)
((member bb keylis)
(if (= (cadr bb) 9)
(setq key "TAB")
(setq key (strcase (chr (cadr bb))))
)
(setq p00 pt loop nil)
)
((or (member bb '((2 13))) (= (car bb) 3) (member (car bb) '(11 25)) (member bb '((2 32))));;左键、回车、右键、空格,缺省退出
(setq p00 pt key t loop nil)
)
)
)
(redraw)
(mapcar 'eval e_lst)
(list p00 key)
)
SLdesign 3.0三领设计下载如下：
通过网盘分享的文件：三领设计
链接: https://pan.baidu.com/s/1iMwJD68IDQpbDfmGsdoQ-A?pwd=inxs 提取码: inxs
缺少slmsg 函数 让元宝AI给陈总的代码加了下注释和代码总结
总结：
这是一个高级的点取函数，主要特点包括：
智能输入：支持鼠标点取和键盘快捷键两种输入方式
实时反馈：光标移动时显示临时图形辅助定位
状态切换：F3切换对象捕捉，F8切换正交模式
多键支持：支持字母、数字、符号等多种快捷键
自动恢复：函数结束时自动恢复之前的系统设置
简洁交互：减少命令行文字显示，提供更直观的操作体验
这个函数常用于需要快速点选位置同时可能需要进行模式切换的CAD操作场景
注释版：
(vl-load-com);; 加载Visual LISP扩展功能，支持ActiveX对象操作
;==============================================================
; 函数名称：key_getpoint - 智能点取函数（支持键盘快捷键）
; 开发信息：Modify By SLdesign V3.0 尘缘一生 QQ:15290049
; 功能描述：不用回车的超级key&getpoint(非循环按键)-----(一级)-----
; 实现带键盘快捷键的点取功能，提高操作效率
; 参数说明：
; ms - 主提示字符串（ms前缀提示）
; ks - 按键提示字符串（ks键位提示）
; 返回值：返回表:(点 Key)
; 点击时 key=t，按快捷键时 key=对应的键名
; 使用示例：
; (key_getpoint "\n 取点.方式->" "[实体(A)/钢筋砼(B)](左键,回车,右键,空格->取点)")
;==============================================================
(defun key_getpoint (ms ks / e_lst f8 f3 loop bb keylis p00 key p2 pt)
;; 初始化部分 ================================================
; 在按键提示字符串末尾添加正交和捕捉的状态提示
; t-string-subst函数用于字符串替换，支持多语言显示
(setq ks (t-string-subst
(slmsg "/正交(F8)/捕捉(F3)]" "/タユ(F8)/汲(F3)]" "/Orth(F8)/Osnap(F3)]")
"]" ks))
; 保存当前的系统变量设置，函数结束时恢复
; sysvar函数用于保存指定的系统变量值
(setq e_lst (sysvar '("OSMODE" "ORTHOMODE"))
; 定义可识别的快捷键列表
; 格式：((类型码 键值) ...) 其中类型码2表示键盘输入
keylis '((2 65) (2 97) ; A a
(2 66) (2 98) ; B b
(2 67) (2 99) ; C c
(2 100) (2 68) ; D d
(2 69) (2 101) ; E e
(2 70) (2 102) ; F f
(2 71) (2 103) ; G g
(2 72) (2 104) ; H h
(2 73) (2 105) ; I i
(2 74) (2 106) ; J j
(2 75) (2 107) ; K k
(2 76) (2 108) ; L l
(2 77) (2 109) ; M m
(2 78) (2 110) ; N n
(2 79) (2 111) ; O o
(2 80) (2 112) ; P p
(2 81) (2 113) ; Q q
(2 82) (2 114) ; R r
(2 83) (2 115) ; S s
(2 84) (2 116) ; T t
(2 85) (2 117) ; U u
(2 86) (2 118) ; V v
(2 87) (2 119) ; W w
(2 88) (2 120) ; X x
(2 89) (2 121) ; Y y
(2 90) (2 122) ; Z z
(2 48) ; 0
(2 49) ; 1
(2 50) ; 2
(2 51) ; 3
(2 52) ; 4
(2 53) ; 5
(2 54) ; 6
(2 55) ; 7
(2 56) ; 8
(2 57) ; 9
(2 96) (2 126) ; `~键
(2 9) ; TAB键
(2 45) ; - 减号键
(2 43) (2 61) ; += 等号键
)
; 初始化循环控制变量和状态变量
loop t ; 循环控制标志，初始为真（t）
f8 (getvar "ORTHOMODE"); 保存当前正交模式状态
f3 (getvar "OSMODE") ; 保存当前对象捕捉模式状态
p2 (cadr (grread 5)) ; 预读鼠标位置（grread 5表示非阻塞读取）
)
; 在命令行显示提示信息
(prompt (strcat ms ks))
;; 主循环 ====================================================
(while loop
; 等待用户输入：grread参数说明：
; t - 跟踪光标移动
; 15 - 光标跟踪间隔（毫秒）
; 2 - 返回光标坐标（非零值）
(setq bb (grread t 15 2) ; bb包含输入类型和值
p00 (cadr bb)) ; p00保存当前的坐标点
; 条件判断：根据不同的输入类型执行相应操作
(cond
;; F3键处理 - 切换对象捕捉开关 ===========================
((equal bb '(2 6)); 2表示键盘输入，6是F3键的键值
(cond
; 此处条件判断不完整，可能是代码有误，但保持原样
((and (" "\n " "\n "))
)
; 如果当前捕捉关闭或处于高级捕捉模式，则开启常规捕捉
((or (= f3 0) (>= f3 16384))
(setq f3 16383; 设置为常用捕捉模式组合
f8 0) ; 关闭正交模式
(setvar "ORTHOMODE" f8); 应用正交模式设置
(prompt (slmsg "\n " "\n " "\n ")); 显示状态提示
)
)
(setvar "OSMODE" f3); 应用捕捉模式设置
(redraw); 重绘图面，清除临时图形
)
;; F8键处理 - 切换正交模式开关 ===========================
((equal bb '(2 15)); 2表示键盘输入，15是F8键的键值
(if (= f8 0); 如果当前正交关闭
(progn
(setq f8 1); 开启正交模式
; 此处条件判断不完整，可能是代码有误
(if (and (" "\n " "\n "))
)
)
(progn; 如果当前正交开启
(setq f8 0); 关闭正交模式
(prompt (slmsg "\n " "\n " "\n ")); 显示状态提示
)
)
(setvar "ORTHOMODE" f8); 应用正交模式设置
(redraw); 重绘图面
)
;; 鼠标移动处理 - 类型5表示光标移动 ======================
((= (car bb) 5)
(redraw); 清除之前的临时图形
(setq pt p00); 保存当前鼠标位置
; 如果正交模式开启
(if (= f8 1)
; 此处条件判断不完整，可能是代码有误
(if ( f3 0))
; 应用对象捕捉到当前点
(setq pt (slosnappt nil pt))
)
; 绘制临时图形（可能是十字线或预览图形）
(slslx pt 0)
(setq p00 pt); 更新当前点坐标
)
;; 快捷键处理 - 检查是否按下了定义的快捷键 ===============
((member bb keylis); 检查输入是否在快捷键列表中
; 处理TAB键特殊情况
(if (= (cadr bb) 9); 9是TAB键的键值
(setq key "TAB") ; 特殊处理TAB键
(setq key (strcase (chr (cadr bb)))); 将键值转换为大写字符
)
(setq p00 pt ; 保存当前点
loop nil); 退出循环
)
;; 确认操作处理 - 左键、回车、右键、空格等 ==============
((or (member bb '((2 13))) ; 回车键
(= (car bb) 3) ; 鼠标右键
(member (car bb) '(11 25)); 其他确认键
(member bb '((2 32))) ; 空格键
)
(setq p00 pt ; 保存当前点
key t ; 设置key为t，表示是点击确认
loop nil) ; 退出循环
)
)
)
;; 清理和返回 ================================================
(redraw); 最终重绘，清除所有临时图形
; 恢复之前保存的系统变量设置
; mapcar 'eval 逐个执行保存的恢复命令
(mapcar 'eval e_lst)
; 返回结果：(点坐标 按键标识)
(list p00 key)
)
(defun key_getpoint (ms ks / e_lst f8 f3 loop bb keylis p00 key p2 pt)
;; 替换提示文本
(setq ks (t-string-subst
(slmsg "/正交(F8)/扑捉(F3)]"
"/タユ(F8)/汲(F3)]"
"/Orth(F8)/Osnap(F3)]")
"]" ks))
;; 备份系统变量
(setq e_lst (sysvar '("OSMODE" "ORTHOMODE")))
;; 所有按键列表（修复语法）
(setq keylis
'((2 65) (2 97) ; A a
(2 66) (2 98) ; B b
(2 67) (2 99)
(2 68) (2 100)
(2 69) (2 101)
(2 70) (2 102)
(2 71) (2 103)
(2 72) (2 104)
(2 73) (2 105)
(2 74) (2 106)
(2 75) (2 107)
(2 76) (2 108)
(2 77) (2 109)
(2 78) (2 110)
(2 79) (2 111)
(2 80) (2 112)
(2 81) (2 113)
(2 82) (2 114)
(2 83) (2 115)
(2 84) (2 116)
(2 85) (2 117)
(2 86) (2 118)
(2 87) (2 119)
(2 88) (2 120)
(2 89) (2 121)
(2 90) (2 122)
(2 48) (2 49) (2 50) (2 51) (2 52)
(2 53) (2 54) (2 55) (2 56) (2 57)
(2 96) (2 126)
(2 9) ; TAB
(2 45) ; -
(2 43) (2 61))) ; + and =
(setq loop t
f8 (getvar "ORTHOMODE")
f3 (getvar "OSMODE")
p2 (cadr (grread 5)))
(prompt (strcat ms ks))
(while loop
(setq bb(grread t 15 2)
p00 (cadr bb))
(cond
;; ---------------- F3 捕捉 --------------------
((and (= (car bb) 2) (= (cadr bb) 6))
(if (and (< f3 16384) (/= f3 0))
(progn
(setq f3 (+ f3 16384))
(prompt (slmsg "\n <对象捕捉 关>"
"\n <癸禜 闽>"
"\n <OSnap Off>")))
(progn
(setq f3 16383f8 0)
(setvar "ORTHOMODE" f8)
(prompt (slmsg "\n <对象捕捉 开>"
"\n <癸禜 秨>"
"\n <OSnap On>"))))
(setvar "OSMODE" f3) (redraw))
;; ---------------- F8 正交 --------------------
((and (= (car bb) 2) (= (cadr bb) 15))
(if (= f8 0)
(progn
(setq f8 1)
(if (and (< f3 16384) (/= f3 0))
(setq f3 (+ f3 16384)))
(setvar "OSMODE" f3)
(prompt (slmsg "\n <正交 开>"
"\n <タユ 秨>"
"\n <Orth open>")))
(progn
(setq f8 0)
(prompt (slmsg "\n <正交 关>"
"\n <タユ 闽>"
"\n <Orth off>"))))
(setvar "ORTHOMODE" f8) (redraw))
;; ---------------- 鼠标移动 --------------------
((= (car bb) 5)
(redraw)
(setq pt p00)
;; 正交
(if (= f8 1)
(setq pt (if (< (abs (- (car p2) (car p00)))
(abs (- (cadr p2) (cadr p00))))
(list (car p2)(cadr p00))
(list (car p00) (cadr p2)))))
;; 捕捉
(if (and (<= f3 16384) (> f3 0))
(setq pt (slosnappt nil pt))
(slslx pt 0))
(setq p00 pt))
;; ---------------- 键盘字母/数字 --------------------
((vl-some '(lambda (x) (equal x bb)) keylis)
(setq key (if (= (cadr bb) 9)
"TAB"
(strcase (chr (cadr bb)))))
(setq p00 pt loop nil))
;; ---------------- 退出（左键/回车/右键/空格） --------------------
((or
(and (= (car bb) 2) (= (cadr bb) 13)) ; 回车
(= (car bb) 3) ; 右键
(member (car bb) '(11 25))
(and (= (car bb) 2) (= (cadr bb) 32)) ; 空格
(= (car bb) 3))
(setq p00 pt key t loop nil))
)
)
(redraw)
(mapcar 'eval e_lst)
(list p00 key)
)
zjy2999 发表于 2025-11-24 14:48
缺少slmsg 函数
那只不过是提示，把 (SLMSG "1" "2" 3")--->直接替换为 “1”
当然，其他还有函数 这是干嘛的？？ qifeifei 发表于 2025-11-24 12:05
【qifeifei 】已被【tranque】解除禁言
页:
[1]