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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 8向滑动圆盘grvecs做的，麻烦路过的大神帮优化一下
1234下一页
返回列表 发新帖
查看: 3537|回复: 38

[提问] 8向滑动圆盘grvecs做的，麻烦路过的大神帮优化一下

[复制链接]
努.力
发表于 2023-11-30 17:32:52 | 显示全部楼层 |阅读模式

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

s1  p1 p2
s1  p2 p3
c1  p0 p3

s2  p3 p4
s2  p4 p5
s2  p5 p6
s2  p6 p7
s2  p7 p8
c2  p0 p8

s3  p8 p9
s3  p9 p10
s3  p10 p11
s3  p11 p12
s3  p12 p13
c3  p0 p13

s4  p13 p14
s4  p14 p15
s4  p15 p16
s4  p16 p17
s4  p17 p18
c4  p0 p18

s5  p18 p19
s5  p19 p20
s5  p20 p21
s5  p21 p22
s5  p22 p23
c5  p0 p23

s6  p23 p24
s6  p24 p25
s6  p25 p26
s6  p26 p27
s6  p27 p28
c6  p0 p28

s7  p28 p29
s7  p29 p30
s7  p30 p31
s7  p31 p32
s7  p32 p33
c7  p0 p33

s8  p33 p34
s8  p34 p35
s8  p35 p36
s8  p36 p37
s8  p37 p38
c8  p0 p38

s1  p38 p39
s1  p39 p40
s1  p40 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?mo ... amp;_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
)






本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x

评分

参与人数 1明经币 +1 收起 理由
仲文玉 + 1 鼓励一下

查看全部评分

回复

使用道具 举报

飞雪神光
发表于 2023-11-30 20:38:32 | 显示全部楼层
  1. (defun c:1w (/ aj an an0 bl cx gr jl jp lm-get-circlepts-pt1 loop p0 pj sx)
  2.         (defun lm-get-circlepts-pt1 (pt10 bj an0 co / an an1 d pt pt1)
  3.                 (setq d (/ 360.0 8))
  4.                 (setq an (+ an0 (* pi 0.25)))
  5.                 (setq an1 an0)
  6.                 (setq pt (polar pt10 an1 bj))
  7.                 (grdraw pt10 pt co)
  8.                 (setq pt (polar pt10 an bj))
  9.                 (grdraw pt10 pt co)
  10.                 (repeat 4
  11.                         (setq pt (polar pt10 an1 bj))
  12.                         (setq pt1 pt)
  13.                         (setq an1 (+ an1 (* (/ (/ 360.0 32) 180.0) pi)))
  14.                         (setq pt (polar pt10 an1 bj))
  15.                         (grdraw pt1 pt co)
  16.                 )
  17.         )
  18.         (if (setq p0 (getpoint "\n请指定第一点："))
  19.     (progn
  20.                         (setq sx 6 cx 4 jl 0.4)
  21.                         (setq loop t)
  22.                         (while loop
  23.                                 (setq gr (grread t 8) aj (car gr) jp (cadr gr))
  24.                                 (cond
  25.                                         ((= aj 3) (setq loop nil) (redraw) (setq aj "左键") )
  26.                                         ((= aj 25) (setq loop nil) (redraw) (setq aj "右键") )
  27.                                         ((= aj 5)
  28.                                                 (redraw)
  29.                                                 (setq pj (distance p0 jp))
  30.                                                 (setq bl (*(getvar'viewsize)jl))
  31.                                                 (setq an0 (* pi 1.875))
  32.                                                 (repeat 8
  33.                                                         (lm-get-circlepts-pt1 p0 bl an0 cx)
  34.                                                         (setq an0 (+ an0 (* pi 0.25)))
  35.                                                 )
  36.                                                 (setq an (angle p0 jp))
  37.                                                 (cond
  38.                                                         ((< (* pi 0.125) an (* pi 0.375)) (lm-get-circlepts-pt1 p0 bl (* pi 0.125) sx))
  39.                                                         ((< (* pi 0.375) an (* pi 0.625)) (lm-get-circlepts-pt1 p0 bl (* pi 0.375) sx))
  40.                                                         ((< (* pi 0.625) an (* pi 0.875)) (lm-get-circlepts-pt1 p0 bl (* pi 0.625) sx))
  41.                                                         ((< (* pi 0.875) an (* pi 1.125)) (lm-get-circlepts-pt1 p0 bl (* pi 0.875) sx))
  42.                                                         ((< (* pi 1.125) an (* pi 1.375)) (lm-get-circlepts-pt1 p0 bl (* pi 1.125) sx))
  43.                                                         ((< (* pi 1.375) an (* pi 1.625)) (lm-get-circlepts-pt1 p0 bl (* pi 1.375) sx))
  44.                                                         ((< (* pi 1.625) an (* pi 1.875)) (lm-get-circlepts-pt1 p0 bl (* pi 1.625) sx))
  45.                                                         ((or (<= (* pi 1.875) an (* pi 2)) (<= 0 an (* pi 0.125)))(lm-get-circlepts-pt1 p0 bl (* pi 1.875) sx))
  46.                                                 )
  47.                                                 (if (> pj (*(getvar'viewsize)jl))
  48.                                                         (setq loop nil aj "移动鼠标")
  49.                                                 )
  50.                                         )
  51.                                 )
  52.                         )
  53.                 )
  54.         )
  55.         (princ)
  56. )

评分

参与人数 3明经币 +3 收起 理由
bssurvey + 1 赞一个!
lee50310 + 1 赞一个!
努.力 + 1 很给力!

查看全部评分

回复 支持 2 反对 0

使用道具 举报

飞雪神光
发表于 2023-12-3 15:26:19 | 显示全部楼层
  1. (defun c:x(/ a)
  2.         (setq
  3.                 a (diy 0.2 "爽歪歪" "←" "→" "↑" "↓" "↖" "↗" "↙" "↘")
  4.                 ;a (strcat a "+" (diy 0.2 "爽歪歪" "←" "→" "↑" "↓" "↖" "↗" "↙" "↘"));套娃
  5.         )
  6.         (princ a)
  7.         (princ)
  8. )

  10. ;(diy 0.07 ts 左滑 右滑 上滑 下滑 左上滑 右上滑  左下滑 右下滑)
  11. (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)
  12.         (defun *error*(msg / *error*);出错处理
  13.                 (setvar'cursorsize gb);恢复光标大小
  14.                 (setvar'pickbox bk);恢复靶框大小
  15.                 (redraw);更新
  16.                 (setq aj nil)
  17.         )
  18.         ;飞雪神光 2023-11-30 http://bbs.mjtd.com/thread-188998-1-1.html
  19.         ;矢量线
  20.         ;(grvecs (list 颜色 点 点 颜色 点 点))
  21.         ;矢量线
  22.         ;(grdraw 点 长度 角度 颜色)
  23.         (defun grdral(pt10 bj an0 co / an an1 pt pt1)
  24.                 (setq
  25.                         an (+ an0 (/ pi (/ n 2)))
  26.                         an1 an0
  27.                         pt (polar pt10 an1 bj)
  28.                 )
  29.                 (grdraw pt10 pt co)
  30.                 (setq pt (polar pt10 an bj))
  31.                 (grdraw pt10 pt co)
  32.                 (repeat (/ n 2)
  33.                         (setq
  34.                                 pt (polar pt10 an1 bj)
  35.                                 pt1 pt
  36.                                 an1 (+ an1 (* (/ (/ 360.0 32) 180.0) pi))
  37.                                 pt (polar pt10 an1 bj)
  38.                         )
  39.                         (grdraw pt1 pt co);滑盘外圈颜色
  40.                 )
  41.         )
  42.         ;————————————————————
  43.         (if(= bs "")(setq bs 0.07)) ;屏幕高度的倍数
  44.         (setq
  45.                 n 8 ;滑盘等分数
  46.                 xc 160 ;非光标处滑盘颜色
  47.                 gc 6 ;光标处滑盘颜色
  48.                 p0 (cadr (grread *));滑盘中心点
  49.                 gb (getvar'cursorsize);记录光标大小
  50.                 bk (getvar'pickbox);记录靶框大小
  51.                 loop t
  52.                 princpd t
  53.                 princpd1 1
  54.                 princpd2 2
  55.         )
  56.         (setvar'cursorsize 1);设置光标大小
  57.         (setvar'pickbox 1);设置靶框大小
  58.         ;————————————————————鼠标移动前绘制滑盘
  59.         (setq an0 (* pi 1.875))
  60.         (repeat n
  61.                 (grdral p0 (*(getvar'viewsize)bs) an0 3)
  62.                 (setq an0 (+ an0 (/ pi (/ n 2))))
  63.         )
  64.         (princ (setq ts (strcat ts " 左滑：" fx_z " 右滑：" fx_y " 上滑：" fx_s " 下滑：" fx_x " 左上滑：" fx_zs " 右上滑：" fx_ys " 左下滑：" fx_zx " 右下滑：" fx_yx)));提示
  65.         ;————————————————————
  66.         (while loop
  67.                 ;(if(/= ss "")(sssetfirst()ss));如果已选中对象则亮显它
  68.                 (setq
  69.                         gr (grread t 8)
  70.                         aj0 (car gr)
  71.                         jp (cadr gr)
  72.                 )
  73.                 (cond
  74.                         ((= aj0 3) (setq loop nil) (setq aj "左键") )
  75.                         ((= aj0 25) (setq loop nil) (setq aj "右键") )
  76.                         ((= aj0 5) ;移动鼠标触发距离
  77.                                 (setq
  78.                                         bl (*(getvar'viewsize)bs);滑盘大小(屏幕高度×倍数)
  79.                                         pj (distance p0 jp)
  80.                                 )
  81.                                 (if (> pj (* bl 0.07))
  82.                                         (progn
  83.                                                 (redraw);更新
  84.                                                 ;————————————————————鼠标移动后绘制滑盘
  85.                                                 (setq an0 (* pi 1.875))
  86.                                                 (repeat n
  87.                                                         (grdral p0 bl an0 xc);非光标处滑盘颜色
  88.                                                         (setq an0 (+ an0 (/ pi (/ n 2))))
  89.                                                 )
  90.                                                 (grdraw p0 jp 1);光标引线
  91.                                                 ;————————————————————8向滑动判断
  92.                                                 (setq ts1 (strcat "\n " ts)) ;提示
  93.                                                 (setq an (angle p0 jp))
  94.                                                 ;(vl-string-subst "替换后的文字" "要替换的文字" wz);字符串替换，替换wz里指定的字符串
  95.                                                 ;(print (list princpd1 princpd2))
  96.                                                 (cond
  97.                                                         ((< (* pi 0.125) an (* pi 0.375))
  98.                                                                 (grdral p0 bl (* pi 0.125) gc) (setq hd "右上滑")
  99.                                                                 (if (/= fx_ys "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_ys) ts1)))
  100.                                                                 (if (= princpd1 princpd2)
  101.                                                                         (if princpd
  102.                                                                                 (progn
  103.                                                                                         ;(princ (strcat "\n " ts1 "\n " hd "：" fx_ys))
  104.                                                                                         (princ (strcat "\n " hd "：" fx_ys))
  105.                                                                                         (setq princpd nil)
  106.                                                                                 )
  107.                                                                         )
  108.                                                                         (setq princpd t princpd1 princpd2)
  109.                                                                 )
  110.                                                                 (setq princpd2 1)
  111.                                                         );↗
  112.                                                         ((< (* pi 0.375) an (* pi 0.625))
  113.                                                                 (grdral p0 bl (* pi 0.375) gc) (setq hd "上滑")
  114.                                                                 (if (/= fx_s "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_s) ts1)))
  115.                                                                 (if (= princpd1 princpd2)
  116.                                                                         (if princpd
  117.                                                                                 (progn
  118.                                                                                         ;(princ (strcat "\n " ts1 "\n " hd "：" fx_s))
  119.                                                                                         (princ (strcat "\n " hd "：" fx_s))
  120.                                                                                         (setq princpd nil)
  121.                                                                                 )
  122.                                                                         )
  123.                                                                         (setq princpd t princpd1 princpd2)
  124.                                                                 )
  125.                                                                 (setq princpd2 2)
  126.                                                         );↑
  127.                                                         ((< (* pi 0.625) an (* pi 0.875))
  128.                                                                 (grdral p0 bl (* pi 0.625) gc) (setq hd "左上滑")
  129.                                                                 (if (/= fx_zs "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_zs) ts1)))
  130.                                                                 (if (= princpd1 princpd2)
  131.                                                                         (if princpd
  132.                                                                                 (progn
  133.                                                                                         (princ (strcat "\n "  hd "：" fx_zs))
  134.                                                                                         (setq princpd nil)
  135.                                                                                 )
  136.                                                                         )
  137.                                                                         (setq princpd t princpd1 princpd2)
  138.                                                                 )
  139.                                                                 (setq princpd2 3)
  140.                                                         );↖
  141.                                                         ((< (* pi 0.875) an (* pi 1.125))
  142.                                                                 (grdral p0 bl (* pi 0.875) gc) (setq hd "左滑")
  143.                                                                 (if (/= fx_z "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_z) ts1)))
  144.                                                                 (if (= princpd1 princpd2)
  145.                                                                         (if princpd
  146.                                                                                 (progn
  147.                                                                                         (princ (strcat "\n " hd "：" fx_z))
  148.                                                                                         (setq princpd nil)
  149.                                                                                 )
  150.                                                                         )
  151.                                                                         (setq princpd t princpd1 princpd2)
  152.                                                                 )
  153.                                                                 (setq princpd2 4)
  154.                                                         );←
  155.                                                         ((< (* pi 1.125) an (* pi 1.375))
  156.                                                                 (grdral p0 bl (* pi 1.125) gc) (setq hd "左下滑")
  157.                                                                 (if (/= fx_zx "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_zx) ts1)))
  158.                                                                 (if (= princpd1 princpd2)
  159.                                                                         (if princpd
  160.                                                                                 (progn
  161.                                                                                         (princ (strcat "\n " hd "：" fx_zx))
  162.                                                                                         (setq princpd nil)
  163.                                                                                 )
  164.                                                                         )
  165.                                                                         (setq princpd t princpd1 princpd2)
  166.                                                                 )
  167.                                                                 (setq princpd2 5)
  168.                                                         );↙
  169.                                                         ((< (* pi 1.375) an (* pi 1.625))
  170.                                                                 (grdral p0 bl (* pi 1.375) gc) (setq hd "下滑")
  171.                                                                 (if (/= fx_x "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_x) ts1)))
  172.                                                                 (if (= princpd1 princpd2)
  173.                                                                         (if princpd
  174.                                                                                 (progn
  175.                                                                                         (princ (strcat "\n " hd "：" fx_x))
  176.                                                                                         (setq princpd nil)
  177.                                                                                 )
  178.                                                                         )
  179.                                                                         (setq princpd t princpd1 princpd2)
  180.                                                                 )
  181.                                                                 (setq princpd2 6)
  182.                                                         );↓
  183.                                                         ((< (* pi 1.625) an (* pi 1.875))
  184.                                                                 (grdral p0 bl (* pi 1.625) gc) (setq hd "右下滑")
  185.                                                                 (if (/= fx_yx "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_yx) ts1)))
  186.                                                                 (if (= princpd1 princpd2)
  187.                                                                         (if princpd
  188.                                                                                 (progn
  189.                                                                                         (princ (strcat "\n " hd "：" fx_yx))
  190.                                                                                         (setq princpd nil)
  191.                                                                                 )
  192.                                                                         )
  193.                                                                         (setq princpd t princpd1 princpd2)
  194.                                                                 )
  195.                                                                 (setq princpd2 7)
  196.                                                         );↘
  197.                                                         ((or (<= (* pi 1.875) an (* pi 2)) (<= 0 an (* pi 0.125)))(grdral p0 bl (* pi 1.875) gc) (setq hd "右滑")
  198.                                                                 (if (/= fx_y "") (setq ts1 (vl-string-subst "" (strcat " " hd "：" fx_y) ts1)))
  199.                                                                 (if (= princpd1 princpd2)
  200.                                                                         (if princpd
  201.                                                                                 (progn
  202.                                                                                         (princ (strcat "\n " hd "：" fx_y))
  203.                                                                                         (setq princpd nil)
  204.                                                                                 )
  205.                                                                         )
  206.                                                                         (setq princpd t princpd1 princpd2)
  207.                                                                 )
  208.                                                                 (setq princpd2 8)
  209.                                                         );→
  210.                                                 );————————————————————
  211.                                                 (if (> pj (* (* (getvar 'viewsize) bs) 1))
  212.                                                         (progn ;光标离开滑盘
  213.                                                                 (setq loop nil)
  214.                                                                 (setvar'cursorsize gb);恢复光标大小
  215.                                                                 (setvar'pickbox bk);恢复靶框大小
  216.                                                                 (redraw);更新
  217.                                                         )
  218.                                                 )
  219.                                         )
  220.                                  (setq aj ":盘外")
  221.                                 )
  222.                         );————————————————————移动鼠标结束
  223.                         ;————————————————————按键盘(grread)
  224.                         ((= aj0 2)
  225.                                 (setq loop nil)
  226.                                 (cond
  227.                                         ((= jp 96) (setq aj "`"))
  228.                                         ((or(= jp 113)(= jp 81)) (setq aj "q"))
  229.                                         ((or(= jp 119)(= jp 87)) (setq aj "w"))
  230.                                         ((or(= jp 101)(= jp 69)) (setq aj "e"))
  231.                                         ((or(= jp 114)(= jp 82)) (setq aj "r"))
  232.                                         ((or(= jp 116)(= jp 84)) (setq aj "t"))
  233.                                         ((or(= jp 121)(= jp 89)) (setq aj "y"))
  234.                                         ((or(= jp 117)(= jp 85)) (setq aj "u"))
  235.                                         ((or(= jp 105)(= jp 73)) (setq aj "i"))
  236.                                         ((or(= jp 111)(= jp 79)) (setq aj "o"))
  237.                                         ((or(= jp 112)(= jp 80)) (setq aj "p"))
  238.                                         ((= jp 91) (setq aj "["))
  239.                                         ((= jp 93) (setq aj "]"))
  240.                                         ((= jp 8) (setq aj "删除")) ;Backspace
  241.                                         ((= jp 61) (setq aj "="))
  242.                                         ((or(= jp 97)(= jp 65)) (setq aj "a"))
  243.                                         ((or(= jp 115)(= jp 83)) (setq aj "s"))
  244.                                         ((or(= jp 100)(= jp 68)) (setq aj "d"))
  245.                                         ((or(= jp 102)(= jp 70)) (setq aj "f"))
  246.                                         ((or(= jp 103)(= jp 71)) (setq aj "g"))
  247.                                         ((or(= jp 104)(= jp 72)) (setq aj "h"))
  248.                                         ((or(= jp 106)(= jp 74)) (setq aj "j"))
  249.                                         ((or(= jp 107)(= jp 75)) (setq aj "k"))
  250.                                         ((or(= jp 108)(= jp 76)) (setq aj "l"))
  251.                                         ((= jp 59) (setq aj ";"))
  252.                                         ((= jp 39) (setq aj "'"))
  253.                                         ((or(= jp 122)(= jp 90)) (setq aj "z"))
  254.                                         ((or(= jp 120)(= jp 88)) (setq aj "x"))
  255.                                         ((or(= jp 99)(= jp 67)) (setq aj "c"))
  256.                                         ((or(= jp 118)(= jp 86)) (setq aj "v"))
  257.                                         ((or(= jp 98)(= jp 66)) (setq aj "b"))
  258.                                         ((or(= jp 110)(= jp 78)) (setq aj "n"))
  259.                                         ((or(= jp 109)(= jp 77)) (setq aj "m"))
  260.                                         ((= jp 44) (setq aj ","))
  261.                                         ((= jp 92) (setq aj "\\"))
  262.                                         ((= jp 13) (setq aj "回车"))
  263.                                         ((= jp 32) (setq aj "空格"))
  264.                                         ((= jp 46) (setq aj "."))
  265.                                         ((= jp 48) (setq aj 0))
  266.                                         ((= jp 49) (setq aj 1))
  267.                                         ((= jp 50) (setq aj 2))
  268.                                         ((= jp 51) (setq aj 3))
  269.                                         ((= jp 52) (setq aj 4))
  270.                                         ((= jp 53) (setq aj 5))
  271.                                         ((= jp 54) (setq aj 6))
  272.                                         ((= jp 55) (setq aj 7))
  273.                                         ((= jp 56) (setq aj 8))
  274.                                         ((= jp 57) (setq aj 9))
  275.                                         ((= jp 43) (setq aj "+"))
  276.                                         ((= jp 45) (setq aj "-"))
  277.                                         ((= jp 42) (setq aj "*"))
  278.                                         ((= jp 47) (setq aj "/"))
  279.                                         ((= jp 9) (setq aj "Tab")) ;Tab
  280.                                         ;————————————————————Shift+
  281.                                         ((= jp 123) (setq aj "{"))
  282.                                         ((= jp 125) (setq aj "}"))
  283.                                         ((= jp 58) (setq aj ":"))
  284.                                         ((= jp 34) (setq aj "\""))
  285.                                         ((= jp 60) (setq aj "<"))
  286.                                         ((= jp 62) (setq aj ">"))
  287.                                         ((= jp 63) (setq aj "?"))
  288.                                         ((= jp 124) (setq aj "|"))
  289.                                         ((= jp 126) (setq aj "~"))
  290.                                         ((= jp 33) (setq aj "!"))
  291.                                         ((= jp 64) (setq aj "@"))
  292.                                         ((= jp 35) (setq aj "#"))
  293.                                         ((= jp 36) (setq aj "$"))
  294.                                         ((= jp 37) (setq aj "%"))
  295.                                         ((= jp 94) (setq aj "^"))
  296.                                         ((= jp 38) (setq aj "&"))
  297.                                         ((= jp 40) (setq aj "("))
  298.                                         ((= jp 41) (setq aj ")"))
  299.                                         ((= jp 95) (setq aj "_"))
  300.                                 )
  301.                         )
  302.                 )
  303.         );while
  304.         (setvar'cursorsize gb);恢复光标大小
  305.         (setvar'pickbox bk);恢复靶框大小
  306.         (redraw);更新
  307.         (if hd (setq aj (strcat hd aj)))
  308.         (princ "\n")
  309.         aj
  310. )
回复 支持 1 反对 0

使用道具 举报

lijiao
发表于 2023-12-3 15:06:33 | 显示全部楼层
随便写了一个,可能与你的思路不一样
  2. (defun grrev (/             ANG    ANG0   CODE          FANGWEI        LOOP   PT
  3.               PT0    QUYU   REV           SCALE  TS         TS1        TS2    TS3
  4.               TS4    TS5    TS6           TS7          TS8         YUANPAN
  5.              )
  6.   (defun mat_mxv (m v /)
  7.     (mapcar '(lambda (r) (apply '+ (mapcar '* r v)))
  8.             m
  9.     )
  10.   )
  11.   (defun mat_trp (m /)
  12.     (apply 'mapcar (cons 'list m))
  13.   )
  14.   (defun mat_cen (m q /)
  15.     (mapcar '(lambda (r)
  16.                (mat_mxv (mat_trp q) r)
  17.              )
  18.             m
  19.     )
  20.   )
  21.   (setq        yuanpan        '(5
  22.                   (0.0 0.0 0.0)
  23.                   (0.915327 -0.379141 0.0)
  24.                   (-0.379141 0.915327 0.0)
  25.                   (0.379141 -0.915327 0.0)
  26.                   (0.379141 0.915327 0.0)
  27.                   (-0.379141 -0.915327 0.0)
  28.                   (0.915327 0.379141 0.0)
  29.                   (-0.915327 -0.379141 0.0)
  30.                   (0.0 0.0 0.0)
  31.                   (-0.915327 0.379141 0.0)
  32.                   (-0.156434 0.987688)
  33.                   (-0.45399 0.891007)
  34.                   (-0.45399 0.891007)
  35.                   (-0.707107 0.707107)
  36.                   (-0.707107 0.707107)
  37.                   (-0.891007 0.45399)
  38.                   (-0.891007 0.45399)
  39.                   (-0.987688 0.156434)
  40.                   (-0.987688 0.156434)
  41.                   (-0.987688 -0.156434)
  42.                   (-0.987688 -0.156434)
  43.                   (-0.891007 -0.45399)
  44.                   (-0.891007 -0.45399)
  45.                   (-0.707107 -0.707107)
  46.                   (-0.707107 -0.707107)
  47.                   (-0.45399 -0.891007)
  48.                   (-0.45399 -0.891007)
  49.                   (-0.156434 -0.987688)
  50.                   (-0.156434 -0.987688)
  51.                   (0.156434 -0.987688)
  52.                   (0.156434 -0.987688)
  53.                   (0.45399 -0.891007)
  54.                   (0.45399 -0.891007)
  55.                   (0.707107 -0.707107)
  56.                   (0.707107 -0.707107)
  57.                   (0.891007 -0.45399)
  58.                   (0.891007 -0.45399)
  59.                   (0.987688 -0.156434)
  60.                   (0.987688 -0.156434)
  61.                   (0.987688 0.156434)
  62.                   (0.987688 0.156434)
  63.                   (0.891007 0.45399)
  64.                   (0.891007 0.45399)
  65.                   (0.707107 0.707107)
  66.                   (0.707107 0.707107)
  67.                   (0.45399 0.891007)
  68.                   (0.45399 0.891007)
  69.                   (0.156434 0.987688)
  70.                   (0.156434 0.987688)
  71.                   (-0.156434 0.987688)
  72.                  )
  73.   )
  74.   (setq        quyu '(2
  75.                (0.0 0.0 0.0)
  76.                (0.915327 -0.379141 0.0)
  77.                (0.915327 0.379141 0.0)
  78.                (-1.61054e-15 -6.67109e-16 0.0)
  79.                (0.987688 0.156434 0.0)
  80.                (0.915327 0.379141 0.0)
  81.                (0.987688 -0.156434 0.0)
  82.                (0.987688 0.156434 0.0)
  83.                (0.915327 -0.379141 0.0)
  84.                (0.987688 -0.156434 0.0)
  85.               )
  86.   )

  88.   (setq        ts1 '(1 (0.15808 -0.0956111 0.0) (0.15808 0.206223 0.0))
  89.   )
  90.   (setq        ts2 '(1
  91.               (0.223258 -0.0956111 0.0)
  92.               (0.223258 0.206223 0.0)
  93.               (0.15808 -0.0956111 0.0)
  94.               (0.15808 0.206223 0.0)
  95.              )
  96.   )
  97.   (setq        ts3 '(1
  98.               (0.288436 -0.0956111 0.0)
  99.               (0.288436 0.206223 0.0)
  100.               (0.223258 -0.0956111 0.0)
  101.               (0.223258 0.206223 0.0)
  102.               (0.15808 -0.0956111 0.0)
  103.               (0.15808 0.206223 0.0)
  104.              )
  105.   )
  106.   (setq        ts4 '(1
  107.               (0.353613 0.206223 0.0)
  108.               (0.288436 -0.0956111 0.0)
  109.               1
  110.               (0.223258 0.206223 0.0)
  111.               (0.288436 -0.0956111 0.0)
  112.               1
  113.               (0.15808 -0.0956111 0.0)
  114.               (0.15808 0.206223 0.0)
  115.              )
  116.   )
  117.   (setq        ts5 '(1
  118.               (0.288436 0.206223 0.0)
  119.               (0.223258 -0.0956111 0.0)
  120.               (0.15808 0.206223 0.0)
  121.               (0.223258 -0.0956111 0.0)
  122.              )
  123.   )
  124.   (setq        ts6 '(1
  125.               (0.353613 -0.0956111 0.0)
  126.               (0.353613 0.206223 0.0)
  127.               (0.288436 0.206223 0.0)
  128.               (0.223258 -0.0956111 0.0)
  129.               (0.15808 0.206223 0.0)
  130.               (0.223258 -0.0956111 0.0)
  131.              )
  132.   )
  133.   (setq        ts7 '(1
  134.               (0.288436 0.206223 0.0)
  135.               (0.223258 -0.0956111 0.0)
  136.               (0.15808 0.206223 0.0)
  137.               (0.223258 -0.0956111 0.0)
  138.               (0.418791 -0.0956111 0.0)
  139.               (0.418791 0.206223 0.0)
  140.               (0.353613 -0.0956111 0.0)
  141.               (0.353613 0.206223 0.0)
  142.              )
  143.   )
  144.   (setq        ts8 '(1
  145.               (0.483969 -0.0956111 0.0)
  146.               (0.483969 0.206223 0.0)
  147.               (0.288436 0.206223 0.0)
  148.               (0.223258 -0.0956111 0.0)
  149.               (0.15808 0.206223 0.0)
  150.               (0.223258 -0.0956111 0.0)
  151.               (0.418791 -0.0956111 0.0)
  152.               (0.418791 0.206223 0.0)
  153.               (0.353613 -0.0956111 0.0)
  154.               (0.353613 0.206223 0.0)
  155.              )
  156.   )



  160.   (setq pt0 (cadr (grread t)))
  161.   (setq loop t)
  162.   (while loop
  163.     (setq pt (grread t))
  164.     (setq code (car pt)
  165.           pt   (cadr pt)
  166.     )
  167.     (redraw)
  168.     (cond
  169.       ((= code 5)
  170.        (setq scale (* (getvar 'viewsize) 0.2))
  171.        (GRVECS yuanpan
  172.                (list (list scale 0 0 (car pt0))
  173.                      (list 0 scale 0 (cadr pt0))
  174.                      (list 0 0 scale 0)
  175.                      '(0 0 0 1)
  176.                )
  177.        )
  178. ;;;绘制圆盘


  181.        (setq ang (angle pt0 pt))
  182.        (setq ang0 (/ (* ang 180.0) pi))
  183.        (setq fangwei (cond
  184.                        ((<= 22.5 ang0 67.5) (setq ts ts2) 2)
  185.                        ((<= 67.5 ang0 112.5) (setq ts ts3) 3)
  186.                        ((<= 112.5 ang0 157.5) (setq ts ts4) 4)
  187.                        ((<= 157.5 ang0 202.5) (setq ts ts5) 5)
  188.                        ((<= 202.5 ang0 247.5) (setq ts ts6) 6)
  189.                        ((<= 247.5 ang0 292.5) (setq ts ts7) 7)
  190.                        ((<= 292.5 ang0 337.5) (setq ts ts8) 8)
  191.                        (t (setq ts ts1) 1)
  192.                      )
  193.        )
  194.        (setq ang0 (/ (* (1- fangwei) 45 pi) 180.0))
  195.        (GRVECS quyu
  196.                (mat_cen        (list (list scale 0 0 (car pt0))
  197.                               (list 0 scale 0 (cadr pt0))
  198.                               (list 0 0 scale 0)
  199.                               '(0 0 0 1)
  200.                         )
  201.                         (list (list (cos ang0) (* -1 (sin ang0)) 0. 0.)
  202.                               (list (sin ang0) (cos ang0) 0. 0.)
  203.                               '(0. 0. 1. 0.)
  204.                               '(0. 0. 0. 1.)
  205.                         )
  206.                )

  208.        )
  209. ;;;绘制区域

  211.        (GRVECS ts
  212.                (list (list scale 0 0 (car pt))
  213.                      (list 0 scale 0 (cadr pt))
  214.                      (list 0 0 scale 0)
  215.                      '(0 0 0 1)
  216.                )
  217.        )
  218. ;;;绘制提示
  219.        (if (> (distance pt0 pt) scale)
  220.          (setq loop nil
  221.                rev  (list 5 fangwei)
  222.          )
  223.        )
  224.       )
  225. ;;;移动鼠标
  226.       ((= code 3)
  227.        (setq ang (angle pt0 pt))
  228.        (setq ang0 (/ (* ang 180.0) pi))
  229.        (setq fangwei (cond
  230.                        ((<= 22.5 ang0 67.5) (setq ts ts2) 2)
  231.                        ((<= 67.5 ang0 112.5) (setq ts ts3) 3)
  232.                        ((<= 112.5 ang0 157.5) (setq ts ts4) 4)
  233.                        ((<= 157.5 ang0 202.5) (setq ts ts5) 5)
  234.                        ((<= 202.5 ang0 247.5) (setq ts ts6) 6)
  235.                        ((<= 247.5 ang0 292.5) (setq ts ts7) 7)
  236.                        ((<= 292.5 ang0 337.5) (setq ts ts8) 8)
  237.                        (t (setq ts ts1) 1)
  238.                      )
  239.        )
  240.        (setq loop nil
  241.              rev  (list 3 fangwei)
  242.        )
  243.       )
  244. ;;;点击鼠标左键
  245.       (t
  246.        (setq loop nil
  247.              rev  (list code pt)
  248.        )
  249.       )
  250.     )
  251.   )
  252.   (redraw)
  253.   rev
  254. )
回复 支持 1 反对 0

使用道具 举报

仲文玉
发表于 2023-11-30 17:55:29 | 显示全部楼层
搞这么复杂
精神可嘉
回复 支持 反对

使用道具 举报

努.力
 楼主| 发表于 2023-11-30 19:57:02 | 显示全部楼层
仲文玉 发表于 2023-11-30 17:55
搞这么复杂
精神可嘉

谢谢版主捧场
回复 支持 反对

使用道具 举报

lijiao
发表于 2023-11-30 20:36:31 | 显示全部楼层
建议用.net做,lisp很难达到实用状态
回复 支持 反对

使用道具 举报

努.力
 楼主| 发表于 2023-11-30 20:54:05 | 显示全部楼层
lijiao 发表于 2023-11-30 20:36
建议用.net做,lisp很难达到实用状态

很好用的啊，特别是当程序要选对象时，要有不同的选项，比如过滤条件，又比如机械行业里，双击一根边线，出现8向盘，在不同的方位滑出，可以标注线性、对齐、角度、表面粗糙度、基准、引线……8项不够可以套娃，8*8*8……又或者改成更多方向
回复 支持 反对

使用道具 举报

努.力
 楼主| 发表于 2023-11-30 21:17:13 | 显示全部楼层
飞雪神光 发表于 2023-11-30 20:38

效果非常好，非常感谢你帮忙优化
回复 支持 反对

使用道具 举报

d1742647821
发表于 2023-12-1 01:03:43 | 显示全部楼层
努.力 发表于 2023-11-30 20:54
很好用的啊，特别是当程序要选对象时，要有不同的选项，比如过滤条件，又比如机械行业里，双击一根边线， ...

人家没说不好用，用.net省10倍力，还能流畅10倍
回复 支持 反对

使用道具 举报

菜卷鱼
发表于 2023-12-1 08:43:15 | 显示全部楼层
我个人认为，用Lisp的话，圆盘改成宫格比较容易实现，判断点在pizza里比矩形里难一些
回复 支持 反对

使用道具 举报

努.力
 楼主| 发表于 2023-12-1 09:37:58 | 显示全部楼层
d1742647821 发表于 2023-12-1 01:03
人家没说不好用，用.net省10倍力，还能流畅10倍

呃，net如此强悍，我得努力学习啊&#128516;
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-3-11 15:45 , Processed in 0.211465 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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