动态信息显示：防止中断退出

尘缘一生 · 发表于 2022-3-17 10:10:15

动态信息显示源码，修改容易中途退出问题。
声明：代码并不能独立运行

(prompt "\n *** 鼠标移动查询信息，鼠标左键写出,右键退出！***")
(setq olderr *error*
*error* myerr
e_lst (sysvar '("osmode" "cmdecho" "fillmode" "ORTHOMODE"))
ss (ssadd)
ss2 (ssadd)
ss3 (ssadd)
loop T
)
(setvar "osmode" 0)
(setvar "fillmode" 1)
(while loop
(setq gr (grread T 8) pt0 (cadr gr))
(cond
((or (= (car gr) 12) (= (car gr) 5))
(setq ft
(vl-catch-all-apply
(function
(lambda ()
(setq ent (nentselp pt0)) ;;选择实体
(if ent
(setq ent
(if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
(car ent)
)
)
)
(if ent
(if (not (or (equal ent oldent) (ssmemb ent ss)))
(progn
(ssadd ent ss3)
(if ss (SL:-Erase ss))
(if (and (= (dxf1 ent 0) "VERTEX") (dxf1 ent 330))
(setq ent (dxf1 ent 330))
)
(redraw ent 3)
(setq ss (dis_info ent pt0 1))
(setq oldent ent)
)
)
(progn
(if ss (SL:-Erase ss))
(setq oldent nil ss (ssadd))
)
)
)
)
)
)
(if (vl-catch-all-error-p ft) ;;如果有错误
(c:sl-info)
)
)
((= (car gr) 3) ;;左键写出
(setq k 3 loop nil)
)
((member (car gr) '(11 25)) ;右键
(if ss (SL:-Erase ss))
(setq *error* olderr)
(mapcar 'eval e_lst)
(if ss3 (slregen ss3))
(exit)
)
)
)
(if ss (SL:-Erase ss)) ;;中断
(if (= k 3)
(sl:drawinfo lst 0 nil)
)
(setq *error* olderr)
(mapcar 'eval e_lst)
(if ss3 (slregen ss3))
)
;;------------------------------------------
(prompt "\n ***使用命令：sl-info ***")
(princ)

liwen888888 · 发表于 2022-3-17 14:22:06

是不是动态图元属性

尘缘一生 · 发表于 2022-3-18 22:54:47

liwen888888 发表于 2022-3-17 14:22
是不是动态图元属性

是的，代码改写的。。。。。。。。。。。。。。。。。

zhaoxt · 发表于 2022-12-22 10:56:34

尘缘一生发表于 2022-3-18 22:54
是的，代码改写的。。。。。。。。。。。。。。。。。

已下载，好好学习一下

00放飞梦想00 · 发表于 2022-12-22 21:32:07

不知为什么，不能用，命令后直接退出去了

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

动态信息显示：防止中断退出

本帖子中包含更多资源