8向滑动圆盘grvecs做的，麻烦路过的大神帮优化一下
8向滑动圆盘grvecs做的，可以根据鼠标在不同的方向滑出，实现不同的功能。圆盘大小是根据屏幕高度百分比定的，可以自行修改。
仿Solidworks右键圆盘……
我平时工作主要使用Creo和SolidWorks，CAD用来出工程图。
平时一直在群里潜水，发言不多，但也喜欢翻翻聊天记录，总会有所收获。
程序也算不算是是自己写的，都是借用个大师的代码，也非常感谢各位大神的热心指点。
代码是用记事本东拼西凑在一起，拼得很不雅观，还望海涵。
程序的最终功能尚未完成，但是整体结构已定型，最后是改成通用函数的。
代码很拙，恳请路过的大神帮忙优化一下，不胜感激
(defun c:1w(/ ang bl i p0
p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16 p17 p18 p19 p20
p21 p22 p23 p24 p25 p26 p27 p28 p29 p30 p31 p32 p33 p34 p35 p36 p37 p38 p39 p40
s1 s2 s3 s4 s5 s6 s7 s8
c1 c2 c3 c4 c5 c6 c7 c8)
(if (setq p0 (getpoint "\n 请指定第一点："))
(progn
(setq sx 160 cx 150 jl 0.08)
(setq loop t)
(while loop
(setq gr (grread t 8) aj (car gr) jp (cadr gr) pj (distance p0 jp))
(cond
((= aj 3) (setq loop nil) (setq aj "左键") )
((= aj 25) (setq loop nil) (setq aj "右键") )
((= aj 5)
(setq gbfwj (atof (R2dms (jsfwj p0 jp)) ) )
(cond
((and (> gbfwj 67.5) (< gbfwj 112.5)) (setq s1 6 c1 s1 c8 s1))
((and (> gbfwj 22.5) (< gbfwj 67.5)) (setq s2 6 c2 s2 c1 s2))
((or(and (> gbfwj 0) (< gbfwj 22.5))(and (> gbfwj 0) (< gbfwj 337.5)) ) (setq s3 6 c3 s3 c4 s3))
((and (> gbfwj 292.5) (< gbfwj 337.5)) (setq s4 6 c4 s4 c5 s4))
((and (> gbfwj 247.5) (< gbfwj 229.5)) (setq s5 6 c5 s5 c6 s5))
((and (> gbfwj 202.5) (< gbfwj 247.5)) (setq s6 6 c6 s6 c7 s6))
((and (> gbfwj 157.5) (< gbfwj 202.5)) (setq s7 6 c7 s7 c8 s7))
((and (> gbfwj 112.5) (< gbfwj 157.5)) (setq s8 6 c8 s8 c1 s8))
)
(if (= s1 nil) (setq s1 sx))
(if (= s2 nil) (setq s2 sx))
(if (= s3 nil) (setq s3 sx))
(if (= s4 nil) (setq s4 sx))
(if (= s5 nil) (setq s5 sx))
(if (= s6 nil) (setq s6 sx))
(if (= s7 nil) (setq s7 sx))
(if (= s8 nil) (setq s8 sx))
(if (= c1 nil) (setq c1 cx))
(if (= c2 nil) (setq c2 cx))
(if (= c3 nil) (setq c3 cx))
(if (= c4 nil) (setq c4 cx))
(if (= c5 nil) (setq c5 cx))
(if (= c6 nil) (setq c6 cx))
(if (= c7 nil) (setq c7 cx))
(if (= c8 nil) (setq c8 cx))
(setq bl (*(getvar'viewsize)jl))
(setq ang (/ pi 40) i 1)
(setq p1 (polar p0 ang bl))
(setq p2 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p3 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p4 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p5 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p6 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p7 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p8 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p9 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p10 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p11 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p12 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p13 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p14 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p15 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p16 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p17 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p18 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p19 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p20 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p21 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p22 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p23 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p24 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p25 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p26 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p27 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p28 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p29 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p30 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p31 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p32 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p33 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p34 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p35 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p36 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p37 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p38 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p39 (polar p0(* ang(setq i(+ i 2)))bl))
(setq p40 (polar p0(* ang(setq i(+ i 2)))bl))
(grvecs (list
s1p1 p2
s1p2 p3
c1p0 p3
s2p3 p4
s2p4 p5
s2p5 p6
s2p6 p7
s2p7 p8
c2p0 p8
s3p8 p9
s3p9 p10
s3p10 p11
s3p11 p12
s3p12 p13
c3p0 p13
s4p13 p14
s4p14 p15
s4p15 p16
s4p16 p17
s4p17 p18
c4p0 p18
s5p18 p19
s5p19 p20
s5p20 p21
s5p21 p22
s5p22 p23
c5p0 p23
s6p23 p24
s6p24 p25
s6p25 p26
s6p26 p27
s6p27 p28
c6p0 p28
s7p28 p29
s7p29 p30
s7p30 p31
s7p31 p32
s7p32 p33
c7p0 p33
s8p33 p34
s8p34 p35
s8p35 p36
s8p36 p37
s8p37 p38
c8p0 p38
s1p38 p39
s1p39 p40
s1p40 p1
))
(if (> pj (*(getvar'viewsize)jl))
(setq loop nil aj "移动鼠标")
)
)
)
);while
(redraw) ;更新
)
);if
)
(defun R2dms(r / zd d m s)
(setq zd (/ (* r 180) pi))
(setq d (fix zd)
m (fix (* 60 (- zd d)))
s (* (- (* 60 (- zd d)) m) 60)
)
;(strcat (itoa d) "度" (itoa m) "分" (rtos s 2 2) "秒")
;(setq x 180)(while (>= zd x) (setq zd (- zd x)))
(strcat(rtos zd) "°" ;(itoa m) "'" (rtos s 2 2) "\" "
)
)
;计算坐标方位角函数 lishucheng96 2018-1-7 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=176366&highlight=%B7%BD%CE%BB%BD%C7&_dsign=02446516
(defun jsfwj(pt1 pt2 / dxy fwj)
(setq dxy (mapcar '- pt2 pt1))
(setq fwj (atan (car dxy) (cadr dxy)))
(if (< fwj 0) (setq fwj (+ fwj (* 2 pi))))
fwj
)
(defun c:1w (/ aj an an0 bl cx gr jl jp lm-get-circlepts-pt1 loop p0 pj sx)
(defun lm-get-circlepts-pt1 (pt10 bj an0 co / an an1 d pt pt1)
(setq d (/ 360.0 8))
(setq an (+ an0 (* pi 0.25)))
(setq an1 an0)
(setq pt (polar pt10 an1 bj))
(grdraw pt10 pt co)
(setq pt (polar pt10 an bj))
(grdraw pt10 pt co)
(repeat 4
(setq pt (polar pt10 an1 bj))
(setq pt1 pt)
(setq an1 (+ an1 (* (/ (/ 360.0 32) 180.0) pi)))
(setq pt (polar pt10 an1 bj))
(grdraw pt1 pt co)
)
)
(if (setq p0 (getpoint "\n请指定第一点："))
(progn
(setq sx 6 cx 4 jl 0.4)
(setq loop t)
(while loop
(setq gr (grread t 8) aj (car gr) jp (cadr gr))
(cond
((= aj 3) (setq loop nil) (redraw) (setq aj "左键") )
((= aj 25) (setq loop nil) (redraw) (setq aj "右键") )
((= aj 5)
(redraw)
(setq pj (distance p0 jp))
(setq bl (*(getvar'viewsize)jl))
(setq an0 (* pi 1.875))
(repeat 8
(lm-get-circlepts-pt1 p0 bl an0 cx)
(setq an0 (+ an0 (* pi 0.25)))
)
(setq an (angle p0 jp))
(cond
((< (* pi 0.125) an (* pi 0.375)) (lm-get-circlepts-pt1 p0 bl (* pi 0.125) sx))
((< (* pi 0.375) an (* pi 0.625)) (lm-get-circlepts-pt1 p0 bl (* pi 0.375) sx))
((< (* pi 0.625) an (* pi 0.875)) (lm-get-circlepts-pt1 p0 bl (* pi 0.625) sx))
((< (* pi 0.875) an (* pi 1.125)) (lm-get-circlepts-pt1 p0 bl (* pi 0.875) sx))
((< (* pi 1.125) an (* pi 1.375)) (lm-get-circlepts-pt1 p0 bl (* pi 1.125) sx))
((< (* pi 1.375) an (* pi 1.625)) (lm-get-circlepts-pt1 p0 bl (* pi 1.375) sx))
((< (* pi 1.625) an (* pi 1.875)) (lm-get-circlepts-pt1 p0 bl (* pi 1.625) sx))
((or (<= (* pi 1.875) an (* pi 2)) (<= 0 an (* pi 0.125)))(lm-get-circlepts-pt1 p0 bl (* pi 1.875) sx))
)
(if (> pj (*(getvar'viewsize)jl))
(setq loop nil aj "移动鼠标")
)
)
)
)
)
)
(princ)
) (defun c:x(/ a)
(setq
a (diy 0.2 "爽歪歪" "←" "→" "↑" "↓" "↖" "↗" "↙" "↘")
;a (strcat a "+" (diy 0.2 "爽歪歪" "←" "→" "↑" "↓" "↖" "↗" "↙" "↘"));套娃
)
(princ a)
(princ)
)
;(diy 0.07 ts 左滑 右滑 上滑 下滑 左上滑 右上滑左下滑 右下滑)
(defun diy(bs ts fx_z fx_y fx_s fx_x fx_zs fx_ys fx_zx fx_yx / *error* n an an0 bl gr jp grdral loop p0 pj xc gc hd aj)
(defun *error*(msg / *error*);出错处理
(setvar'cursorsize gb);恢复光标大小
(setvar'pickbox bk);恢复靶框大小
(redraw);更新
(setq aj nil)
)
;飞雪神光 2023-11-30 http://bbs.mjtd.com/thread-188998-1-1.html
;矢量线
;(grvecs (list 颜色 点 点 颜色 点 点))
;矢量线
;(grdraw 点 长度 角度 颜色)
(defun grdral(pt10 bj an0 co / an an1 pt pt1)
(setq
an (+ an0 (/ pi (/ n 2)))
an1 an0
pt (polar pt10 an1 bj)
)
(grdraw pt10 pt co)
(setq pt (polar pt10 an bj))
(grdraw pt10 pt co)
(repeat (/ n 2)
(setq
pt (polar pt10 an1 bj)
pt1 pt
an1 (+ an1 (* (/ (/ 360.0 32) 180.0) pi))
pt (polar pt10 an1 bj)
)
(grdraw pt1 pt co);滑盘外圈颜色
)
)
;————————————————————
(if(= bs "")(setq bs 0.07)) ;屏幕高度的倍数
(setq
n 8 ;滑盘等分数
xc 160 ;非光标处滑盘颜色
gc 6 ;光标处滑盘颜色
p0 (cadr (grread *));滑盘中心点
gb (getvar'cursorsize);记录光标大小
bk (getvar'pickbox);记录靶框大小
loop t
princpd t
princpd1 1
princpd2 2
)
(setvar'cursorsize 1);设置光标大小
(setvar'pickbox 1);设置靶框大小
;————————————————————鼠标移动前绘制滑盘
(setq an0 (* pi 1.875))
(repeat n
(grdral p0 (*(getvar'viewsize)bs) an0 3)
(setq an0 (+ an0 (/ pi (/ n 2))))
)
(princ (setq ts (strcat ts " 左滑：" fx_z " 右滑：" fx_y " 上滑：" fx_s " 下滑：" fx_x " 左上滑：" fx_zs " 右上滑：" fx_ys " 左下滑：" fx_zx " 右下滑：" fx_yx)));提示
;————————————————————
(while loop
;(if(/= ss "")(sssetfirst()ss));如果已选中对象则亮显它
(setq
gr (grread t 8)
aj0 (car gr)
jp (cadr gr)
)
(cond
((= aj0 3) (setq loop nil) (setq aj "左键") )
((= aj0 25) (setq loop nil) (setq aj "右键") )
((= aj0 5) ;移动鼠标触发距离
(setq
bl (*(getvar'viewsize)bs);滑盘大小(屏幕高度×倍数)
pj (distance p0 jp)
)
(if (> pj (* bl 0.07))
(progn
(redraw);更新
;————————————————————鼠标移动后绘制滑盘
(setq an0 (* pi 1.875))
(repeat n
(grdral p0 bl an0 xc);非光标处滑盘颜色
(setq an0 (+ an0 (/ pi (/ n 2))))
)
(grdraw p0 jp 1);光标引线
;————————————————————8向滑动判断
(setq ts1 (strcat "\n " ts)) ;提示
(setq an (angle p0 jp))
;(vl-string-subst "替换后的文字" "要替换的文字" wz);字符串替换，替换wz里指定的字符串
;(print (list princpd1 princpd2))
(cond
((< (* pi 0.125) an (* pi 0.375))
(grdral p0 bl (* pi 0.125) gc) (setq hd "右上滑")
(if (/= fx_ys "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_ys) ts1)))
(if (= princpd1 princpd2)
(if princpd
(progn
;(princ (strcat "\n " ts1 "\n " hd "：" fx_ys))
(princ (strcat "\n " hd "：" fx_ys))
(setq princpd nil)
)
)
(setq princpd t princpd1 princpd2)
)
(setq princpd2 1)
);↗
((< (* pi 0.375) an (* pi 0.625))
(grdral p0 bl (* pi 0.375) gc) (setq hd "上滑")
(if (/= fx_s "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_s) ts1)))
(if (= princpd1 princpd2)
(if princpd
(progn
;(princ (strcat "\n " ts1 "\n " hd "：" fx_s))
(princ (strcat "\n " hd "：" fx_s))
(setq princpd nil)
)
)
(setq princpd t princpd1 princpd2)
)
(setq princpd2 2)
);↑
((< (* pi 0.625) an (* pi 0.875))
(grdral p0 bl (* pi 0.625) gc) (setq hd "左上滑")
(if (/= fx_zs "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_zs) ts1)))
(if (= princpd1 princpd2)
(if princpd
(progn
(princ (strcat "\n "hd "：" fx_zs))
(setq princpd nil)
)
)
(setq princpd t princpd1 princpd2)
)
(setq princpd2 3)
);↖
((< (* pi 0.875) an (* pi 1.125))
(grdral p0 bl (* pi 0.875) gc) (setq hd "左滑")
(if (/= fx_z "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_z) ts1)))
(if (= princpd1 princpd2)
(if princpd
(progn
(princ (strcat "\n " hd "：" fx_z))
(setq princpd nil)
)
)
(setq princpd t princpd1 princpd2)
)
(setq princpd2 4)
);←
((< (* pi 1.125) an (* pi 1.375))
(grdral p0 bl (* pi 1.125) gc) (setq hd "左下滑")
(if (/= fx_zx "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_zx) ts1)))
(if (= princpd1 princpd2)
(if princpd
(progn
(princ (strcat "\n " hd "：" fx_zx))
(setq princpd nil)
)
)
(setq princpd t princpd1 princpd2)
)
(setq princpd2 5)
);↙
((< (* pi 1.375) an (* pi 1.625))
(grdral p0 bl (* pi 1.375) gc) (setq hd "下滑")
(if (/= fx_x "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_x) ts1)))
(if (= princpd1 princpd2)
(if princpd
(progn
(princ (strcat "\n " hd "：" fx_x))
(setq princpd nil)
)
)
(setq princpd t princpd1 princpd2)
)
(setq princpd2 6)
);↓
((< (* pi 1.625) an (* pi 1.875))
(grdral p0 bl (* pi 1.625) gc) (setq hd "右下滑")
(if (/= fx_yx "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_yx) ts1)))
(if (= princpd1 princpd2)
(if princpd
(progn
(princ (strcat "\n " hd "：" fx_yx))
(setq princpd nil)
)
)
(setq princpd t princpd1 princpd2)
)
(setq princpd2 7)
);↘
((or (<= (* pi 1.875) an (* pi 2)) (<= 0 an (* pi 0.125)))(grdral p0 bl (* pi 1.875) gc) (setq hd "右滑")
(if (/= fx_y "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_y) ts1)))
(if (= princpd1 princpd2)
(if princpd
(progn
(princ (strcat "\n " hd "：" fx_y))
(setq princpd nil)
)
)
(setq princpd t princpd1 princpd2)
)
(setq princpd2 8)
);→
);————————————————————
(if (> pj (* (* (getvar 'viewsize) bs) 1))
(progn ;光标离开滑盘
(setq loop nil)
(setvar'cursorsize gb);恢复光标大小
(setvar'pickbox bk);恢复靶框大小
(redraw);更新
)
)
)
(setq aj ":盘外")
)
);————————————————————移动鼠标结束
;————————————————————按键盘(grread)
((= aj0 2)
(setq loop nil)
(cond
((= jp 96) (setq aj "`"))
((or(= jp 113)(= jp 81)) (setq aj "q"))
((or(= jp 119)(= jp 87)) (setq aj "w"))
((or(= jp 101)(= jp 69)) (setq aj "e"))
((or(= jp 114)(= jp 82)) (setq aj "r"))
((or(= jp 116)(= jp 84)) (setq aj "t"))
((or(= jp 121)(= jp 89)) (setq aj "y"))
((or(= jp 117)(= jp 85)) (setq aj "u"))
((or(= jp 105)(= jp 73)) (setq aj "i"))
((or(= jp 111)(= jp 79)) (setq aj "o"))
((or(= jp 112)(= jp 80)) (setq aj "p"))
((= jp 91) (setq aj "["))
((= jp 93) (setq aj "]"))
((= jp 8) (setq aj "删除")) ;Backspace
((= jp 61) (setq aj "="))
((or(= jp 97)(= jp 65)) (setq aj "a"))
((or(= jp 115)(= jp 83)) (setq aj "s"))
((or(= jp 100)(= jp 68)) (setq aj "d"))
((or(= jp 102)(= jp 70)) (setq aj "f"))
((or(= jp 103)(= jp 71)) (setq aj "g"))
((or(= jp 104)(= jp 72)) (setq aj "h"))
((or(= jp 106)(= jp 74)) (setq aj "j"))
((or(= jp 107)(= jp 75)) (setq aj "k"))
((or(= jp 108)(= jp 76)) (setq aj "l"))
((= jp 59) (setq aj ";"))
((= jp 39) (setq aj "'"))
((or(= jp 122)(= jp 90)) (setq aj "z"))
((or(= jp 120)(= jp 88)) (setq aj "x"))
((or(= jp 99)(= jp 67)) (setq aj "c"))
((or(= jp 118)(= jp 86)) (setq aj "v"))
((or(= jp 98)(= jp 66)) (setq aj "b"))
((or(= jp 110)(= jp 78)) (setq aj "n"))
((or(= jp 109)(= jp 77)) (setq aj "m"))
((= jp 44) (setq aj ","))
((= jp 92) (setq aj "\\"))
((= jp 13) (setq aj "回车"))
((= jp 32) (setq aj "空格"))
((= jp 46) (setq aj "."))
((= jp 48) (setq aj 0))
((= jp 49) (setq aj 1))
((= jp 50) (setq aj 2))
((= jp 51) (setq aj 3))
((= jp 52) (setq aj 4))
((= jp 53) (setq aj 5))
((= jp 54) (setq aj 6))
((= jp 55) (setq aj 7))
((= jp 56) (setq aj 8))
((= jp 57) (setq aj 9))
((= jp 43) (setq aj "+"))
((= jp 45) (setq aj "-"))
((= jp 42) (setq aj "*"))
((= jp 47) (setq aj "/"))
((= jp 9) (setq aj "Tab")) ;Tab
;————————————————————Shift+
((= jp 123) (setq aj "{"))
((= jp 125) (setq aj "}"))
((= jp 58) (setq aj ":"))
((= jp 34) (setq aj "\""))
((= jp 60) (setq aj "<"))
((= jp 62) (setq aj ">"))
((= jp 63) (setq aj "?"))
((= jp 124) (setq aj "|"))
((= jp 126) (setq aj "~"))
((= jp 33) (setq aj "!"))
((= jp 64) (setq aj "@"))
((= jp 35) (setq aj "#"))
((= jp 36) (setq aj "$"))
((= jp 37) (setq aj "%"))
((= jp 94) (setq aj "^"))
((= jp 38) (setq aj "&"))
((= jp 40) (setq aj "("))
((= jp 41) (setq aj ")"))
((= jp 95) (setq aj "_"))
)
)
)
);while
(setvar'cursorsize gb);恢复光标大小
(setvar'pickbox bk);恢复靶框大小
(redraw);更新
(if hd (setq aj (strcat hd aj)))
(princ "\n")
aj
) 随便写了一个,可能与你的思路不一样
(defun grrev (/ ANG ANG0 CODE FANGWEI LOOP PT
PT0 QUYU REV SCALETS TS1 TS2 TS3
TS4 TS5 TS6 TS7 TS8 YUANPAN
)
(defun mat_mxv (m v /)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v)))
m
)
)
(defun mat_trp (m /)
(apply 'mapcar (cons 'list m))
)
(defun mat_cen (m q /)
(mapcar '(lambda (r)
(mat_mxv (mat_trp q) r)
)
m
)
)
(setq yuanpan '(5
(0.0 0.0 0.0)
(0.915327 -0.379141 0.0)
(-0.379141 0.915327 0.0)
(0.379141 -0.915327 0.0)
(0.379141 0.915327 0.0)
(-0.379141 -0.915327 0.0)
(0.915327 0.379141 0.0)
(-0.915327 -0.379141 0.0)
(0.0 0.0 0.0)
(-0.915327 0.379141 0.0)
(-0.156434 0.987688)
(-0.45399 0.891007)
(-0.45399 0.891007)
(-0.707107 0.707107)
(-0.707107 0.707107)
(-0.891007 0.45399)
(-0.891007 0.45399)
(-0.987688 0.156434)
(-0.987688 0.156434)
(-0.987688 -0.156434)
(-0.987688 -0.156434)
(-0.891007 -0.45399)
(-0.891007 -0.45399)
(-0.707107 -0.707107)
(-0.707107 -0.707107)
(-0.45399 -0.891007)
(-0.45399 -0.891007)
(-0.156434 -0.987688)
(-0.156434 -0.987688)
(0.156434 -0.987688)
(0.156434 -0.987688)
(0.45399 -0.891007)
(0.45399 -0.891007)
(0.707107 -0.707107)
(0.707107 -0.707107)
(0.891007 -0.45399)
(0.891007 -0.45399)
(0.987688 -0.156434)
(0.987688 -0.156434)
(0.987688 0.156434)
(0.987688 0.156434)
(0.891007 0.45399)
(0.891007 0.45399)
(0.707107 0.707107)
(0.707107 0.707107)
(0.45399 0.891007)
(0.45399 0.891007)
(0.156434 0.987688)
(0.156434 0.987688)
(-0.156434 0.987688)
)
)
(setq quyu '(2
(0.0 0.0 0.0)
(0.915327 -0.379141 0.0)
(0.915327 0.379141 0.0)
(-1.61054e-15 -6.67109e-16 0.0)
(0.987688 0.156434 0.0)
(0.915327 0.379141 0.0)
(0.987688 -0.156434 0.0)
(0.987688 0.156434 0.0)
(0.915327 -0.379141 0.0)
(0.987688 -0.156434 0.0)
)
)
(setq ts1 '(1 (0.15808 -0.0956111 0.0) (0.15808 0.206223 0.0))
)
(setq ts2 '(1
(0.223258 -0.0956111 0.0)
(0.223258 0.206223 0.0)
(0.15808 -0.0956111 0.0)
(0.15808 0.206223 0.0)
)
)
(setq ts3 '(1
(0.288436 -0.0956111 0.0)
(0.288436 0.206223 0.0)
(0.223258 -0.0956111 0.0)
(0.223258 0.206223 0.0)
(0.15808 -0.0956111 0.0)
(0.15808 0.206223 0.0)
)
)
(setq ts4 '(1
(0.353613 0.206223 0.0)
(0.288436 -0.0956111 0.0)
1
(0.223258 0.206223 0.0)
(0.288436 -0.0956111 0.0)
1
(0.15808 -0.0956111 0.0)
(0.15808 0.206223 0.0)
)
)
(setq ts5 '(1
(0.288436 0.206223 0.0)
(0.223258 -0.0956111 0.0)
(0.15808 0.206223 0.0)
(0.223258 -0.0956111 0.0)
)
)
(setq ts6 '(1
(0.353613 -0.0956111 0.0)
(0.353613 0.206223 0.0)
(0.288436 0.206223 0.0)
(0.223258 -0.0956111 0.0)
(0.15808 0.206223 0.0)
(0.223258 -0.0956111 0.0)
)
)
(setq ts7 '(1
(0.288436 0.206223 0.0)
(0.223258 -0.0956111 0.0)
(0.15808 0.206223 0.0)
(0.223258 -0.0956111 0.0)
(0.418791 -0.0956111 0.0)
(0.418791 0.206223 0.0)
(0.353613 -0.0956111 0.0)
(0.353613 0.206223 0.0)
)
)
(setq ts8 '(1
(0.483969 -0.0956111 0.0)
(0.483969 0.206223 0.0)
(0.288436 0.206223 0.0)
(0.223258 -0.0956111 0.0)
(0.15808 0.206223 0.0)
(0.223258 -0.0956111 0.0)
(0.418791 -0.0956111 0.0)
(0.418791 0.206223 0.0)
(0.353613 -0.0956111 0.0)
(0.353613 0.206223 0.0)
)
)
(setq pt0 (cadr (grread t)))
(setq loop t)
(while loop
(setq pt (grread t))
(setq code (car pt)
pt (cadr pt)
)
(redraw)
(cond
((= code 5)
(setq scale (* (getvar 'viewsize) 0.2))
(GRVECS yuanpan
(list (list scale 0 0 (car pt0))
(list 0 scale 0 (cadr pt0))
(list 0 0 scale 0)
'(0 0 0 1)
)
)
;;;绘制圆盘
(setq ang (angle pt0 pt))
(setq ang0 (/ (* ang 180.0) pi))
(setq fangwei (cond
((<= 22.5 ang0 67.5) (setq ts ts2) 2)
((<= 67.5 ang0 112.5) (setq ts ts3) 3)
((<= 112.5 ang0 157.5) (setq ts ts4) 4)
((<= 157.5 ang0 202.5) (setq ts ts5) 5)
((<= 202.5 ang0 247.5) (setq ts ts6) 6)
((<= 247.5 ang0 292.5) (setq ts ts7) 7)
((<= 292.5 ang0 337.5) (setq ts ts8) 8)
(t (setq ts ts1) 1)
)
)
(setq ang0 (/ (* (1- fangwei) 45 pi) 180.0))
(GRVECS quyu
(mat_cen (list (list scale 0 0 (car pt0))
(list 0 scale 0 (cadr pt0))
(list 0 0 scale 0)
'(0 0 0 1)
)
(list (list (cos ang0) (* -1 (sin ang0)) 0. 0.)
(list (sin ang0) (cos ang0) 0. 0.)
'(0. 0. 1. 0.)
'(0. 0. 0. 1.)
)
)
)
;;;绘制区域
(GRVECS ts
(list (list scale 0 0 (car pt))
(list 0 scale 0 (cadr pt))
(list 0 0 scale 0)
'(0 0 0 1)
)
)
;;;绘制提示
(if (> (distance pt0 pt) scale)
(setq loop nil
rev(list 5 fangwei)
)
)
)
;;;移动鼠标
((= code 3)
(setq ang (angle pt0 pt))
(setq ang0 (/ (* ang 180.0) pi))
(setq fangwei (cond
((<= 22.5 ang0 67.5) (setq ts ts2) 2)
((<= 67.5 ang0 112.5) (setq ts ts3) 3)
((<= 112.5 ang0 157.5) (setq ts ts4) 4)
((<= 157.5 ang0 202.5) (setq ts ts5) 5)
((<= 202.5 ang0 247.5) (setq ts ts6) 6)
((<= 247.5 ang0 292.5) (setq ts ts7) 7)
((<= 292.5 ang0 337.5) (setq ts ts8) 8)
(t (setq ts ts1) 1)
)
)
(setq loop nil
rev(list 3 fangwei)
)
)
;;;点击鼠标左键
(t
(setq loop nil
rev(list code pt)
)
)
)
)
(redraw)
rev
) 搞这么复杂;P
精神可嘉 仲文玉 发表于 2023-11-30 17:55
搞这么复杂
精神可嘉
谢谢版主捧场 建议用.net做,lisp很难达到实用状态 lijiao 发表于 2023-11-30 20:36
建议用.net做,lisp很难达到实用状态
很好用的啊，特别是当程序要选对象时，要有不同的选项，比如过滤条件，又比如机械行业里，双击一根边线，出现8向盘，在不同的方位滑出，可以标注线性、对齐、角度、表面粗糙度、基准、引线……8项不够可以套娃，8*8*8……又或者改成更多方向 飞雪神光 发表于 2023-11-30 20:38
效果非常好，非常感谢你帮忙优化 努.力 发表于 2023-11-30 20:54
很好用的啊，特别是当程序要选对象时，要有不同的选项，比如过滤条件，又比如机械行业里，双击一根边线， ...
人家没说不好用，用.net省10倍力，还能流畅10倍 我个人认为，用Lisp的话，圆盘改成宫格比较容易实现，判断点在pizza里比矩形里难一些 d1742647821 发表于 2023-12-1 01:03
人家没说不好用，用.net省10倍力，还能流畅10倍
呃，net如此强悍，我得努力学习啊😄