插入圆圈序号
本帖最后由 sandyvs 于 2023-4-6 23:44 编辑2023.4.6
嗯。。达到要求了
(defun c:tt (/ *error* cc code gr loop n pt0 ptx xj xx zz)
(defun *error* (msg)
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(progn (princ (strcat "\n错误：" msg))
(if cc
(entdel cc)
)
(if zz
(entdel zz)
)
)
)
(princ)
)
;;;----------------------------------------------------
(setvar "cmdecho" 0)
(setvar "dynmode" 0)
(setq scale (getvar "dimscale"))
(setq n 1)
(setq xx 0)
(princ "/n 空格序号-1，右键退出，插入点更换：s左/f右/e上/d下：<左>")
(setq loop t) ;grread
(while loop
(setq gr (grread t 15 0)
code (car gr)
ptx(cadr gr)
)
(cond
((= code 3)
(redraw)
(setq cc nil)
(setq zz nil)
(setq n (1+ n))
)
((= code 5) ; 鼠标移动
(redraw)
(if cc
(entdel cc)
)
(if zz
(entdel zz)
)
;(setq ptx (osnappt nil ptx))
(setvar "osmode" 0)
(setq pt0 (polar ptx xx (* scale 2)))
(vl-cmdf "circle" pt0 (* scale 2))
(setq cc (entlast))
(entmakeX
(list '(0 . "TEXT")
(cons 1 (vl-princ-to-string n))
(cons 10 pt0)
(cons 40 (* scale 2))
(cons 11 pt0)
(cons 72 1)
(cons 73 2)
)
)
(setq zz (entlast))
)
((MEMBER (CADR GR) '(13 32)) ;空格 回车
(setq n (- n 1))
)
((MEMBER (CADR GR) '(83 115)) ;a键
(setq xx 0)
)
((MEMBER (CADR GR) '(70 102)) ;f键
(setq xx pi)
)
((MEMBER (CADR GR) '(68 100)) ;d键
(setq xx (* 0.5 pi))
)
((MEMBER (CADR GR) '(69 101)) ;e键
(setq xx (* -0.5 pi))
)
((= code 25)
(if cc
(entdel cc)
)
(if zz
(entdel zz)
)
(setq loop nil)
)
)
)
(princ)
)
算是解决了吧，加个循环就好了。。空格 换方向，右击退出，但这个退出是因为错误退出。。
想要动态插入圆序号，请教下，有两个问题：1、最后一个生成的序号没用，如何删除？2、能否在移动过程中按键盘选择序圆插入点，比如上、下、左、右键对应圆的一、二、三、四象限。
(defun c:tt (/ *error* cc code gr loop n pt0 ptx xj xx zz)
(defun *error* ( msg )
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(progn (princ (strcat "\n错误：" msg)) (if cc (entdel cc)) (if zz (entdel zz)))
)
(princ)
)
;;;----------------------------------------------------
(setvar "cmdecho" 0)
(setvar "dynmode" 0)
(setq scale (getvar "dimscale"))
(setq n 1)
(setq tj t)
(while tj
(initget "a s d w")
(setq xj
(cond ((getkword "\n 选择插入点：<a>: ")) ("a")))
(cond
((= xj "a")
(setq xx 0)
)
((= xj "d")
(setq xx pi)
)
((= xj "w")
(setq xx (* -0.5 pi))
)
((= xj "s")
(setq xx (* 0.5 pi))
)
)
(setq loop t) ;grread
(while loop
(setq gr (grread t 15 0)
code (car gr)
ptx(cadr gr)
)
(cond
((= code 3)
(redraw)
(setq cc nil)
(setq zz nil)
(setq n (1+ n))
)
((= code 5) ; 鼠标移动
(redraw)
(if cc
(entdel cc)
)
(if zz
(entdel zz)
)
;(setq ptx (osnappt nil ptx))
(setvar "osmode" 0)
(setq pt0 (polar ptx xx (* scale 2)))
(vl-cmdf "circle" pt0 (* scale 2))
(setq cc (entlast))
(entmakeX
(list '(0 . "TEXT")
(cons 1 (vl-princ-to-string n))
(cons 10 pt0)
(cons 40 (* scale 2))
(cons 11 pt0)
(cons 72 1)
(cons 73 2)
)
)
(setq zz (entlast))
)
;((= code 2) ; 键盘输入
; (princ "\n键盘输入=")(princ pt))
((or(member code '(2 13))(member code '(2 32))) ; 空格，回车
(entdel cc)
(entdel zz)
(redraw)
(setq cc nil)
(setq zz nil)
(setq loop nil)
)
(((= code 25)) ; 鼠标右击
(entdel cc)
(entdel zz)
(redraw)
(setq cc nil)
(setq zz nil)
(setq tj nil)
)
)
)
)
(princ)
)
修改一下这段试试：
((= code 25); 鼠标右击
(entdel cc)
(entdel zz)
(redraw)
(setq cc nil)
(setq zz nil)
(setq loop nil)
)
sandyvs 发表于 2023-3-29 17:39
感谢！可以了，就是按esc，还会留下最后那个。是要加个错误处理吗？错误处理还不太会
加了错误处理，按ESC第一次不会留最后一个，之后还是会留下最后那个 p-3-ianlcc 发表于 2023-4-6 17:29
火爆的人工智能改的如何？
真的有这麽便利吗？
对，但是只是改进，如果完全要它写一个全新的就不太行，好几个都不能运行，也可能是我表达能力还不够。 感谢分享，就是不知怎么调整文字大小。 ssyfeng 发表于 2023-3-29 15:51
修改一下这段试试：
((= code 25); 鼠标右击
感谢！可以了，就是按esc，还会留下最后那个。是要加个错误处理吗？错误处理还不太会 刚开始 发表于 2023-3-29 16:49
感谢分享，就是不知怎么调整文字大小。
额，13年的老哥，不应该啊 本帖最后由 ssyfeng 于 2023-3-29 17:58 编辑
加个错误处理：
chenxiy825 发表于 2023-3-29 20:18
加了错误处理，按ESC第一次不会留最后一个，之后还是会留下最后那个
我这没问题啊 sandyvs 发表于 2023-3-29 17:40
额，13年的老哥，不应该啊
唉！今天请chap3.5修改成输入文字大小圆孔始终和文字一样大。 刚开始 发表于 2023-3-31 12:02
唉！今天请chap3.5修改成输入文字大小圆孔始终和文字一样大。
可以将文字高度、圆半径与当前标注比例关联，改比例的画就一起变了
页:
[1]
2