明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 903|回复: 0

Grread+F3+F8 的事

  [复制链接]
发表于 2023-6-26 21:29:07 | 显示全部楼层 |阅读模式
本帖最后由 尘缘一生 于 2023-6-27 13:25 编辑

如题,经过磨合,现把 《三领设计 V3.0》中的整合,简化发下,
链接:https://pan.baidu.com/s/1t7tNGZiH1kZuLVmtOPzcnA
提取码:keqt
因为 grread  整合正交与扑捉,不好办
尚有遗憾,那就是正交时候,由于点位相同,水平与垂直转换,不易控制方向,

    • ;;移动-拷贝-旋转-镜像-递增-放缩------(一级)---------
    • ;;三领集成  by QQ:15290049 <简化版>
    • ;;ss:实体、实体表、选择集 p0 移动起点 nil | k: t(move) nil(copy)
    • (defun sldomov (ss p0 k / e_lst pt pt1 loop ang dis f3 f8 bb p00)
    •   ;;(setq e_lst (sysvar '("QAFLAGS" "CMDECHO" "NOMUTT" "OSMODE" "ORTHOMODE")))
    •   (cond
    •     ((= (type ss) 'ENAME) (setq ss (ssadd ss))) ;图元
    •     ((= (type ss) 'LIST) (setq ss (sl:pickset-fromlist ss))) ;实体表
    •   )
    •   (command "_.undo" "be") ;;舍弃高级代码,加速
    •   (setvar "cmdecho" 0) ;;命令显示关闭
    •   (setvar "nomutt" 1)
    •   (setvar "qaflags" 0)
    •   (if (= p0 nil) (setq p0 (cadr (grread 5))))
    •   (if (= k nil) ;;复制
    •     (princ
    •       (strcat "\n->[逆转90度(TAB)/取角(A)/<-mir->(D)/↑mir ↓(S)/放大(Q)/缩小(W)/递增(Z)/递减(J)/大一倍(+)/小一半(-)][空格d=->1复制][左键.复制当前][右键/其余键.退出]")
    •     )
    •     (princ
    •       (strcat "\n->[逆转90度(TAB)/取角(A)/<-mir->(D)/↑mir ↓(S)/放大(Q)/缩小(W)/递增(Z)/递减(J)/大一倍(+)/小一半(-)/复制当前(C)][空格d=->1复制][左键.复制当前][右键/其余键.退出]")
    •     )
    •   )
    •   (setq loop t pt1 p0 f8 (getvar "ORTHOMODE") f3 (getvar "OSMODE"))
    •   (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 "\n <对象捕捉 关>")
    •           )
    •           ((or (= f3 0) (>= f3 16384))
    •             (setq f3 16383)
    •             (prompt "\n <对象捕捉 开>")
    •           )
    •         )
    •         (setvar "OSMODE" f3) (redraw)
    •       )   
    •       ((equal bb '(2 15))    ;F8切换正交开关
    •         (if (= f8 0)
    •           (progn (setq f8 1) (prompt "\n <正交 开>"))
    •           (progn (setq f8 0) (prompt "\n <正交 关>"))
    •         )
    •         (setvar "ORTHOMODE" f8) (redraw)
    •       )
    •       ((= (car bb) 5)
    •         (redraw)
    •         (setq pt p00)
    •         (if (= f8 1)
    •           (if (< (abs (- (car p00) (car p0))) (abs (- (cadr p00) (cadr p0))))
    •             (setq pt (list (car p00) (cadr p0)))
    •             (setq pt (list (car p0)(cadr p00)))
    •           )
    •         )
    •         (if (> (/ (distance p0 p00) (getvar "VIEWSIZE")) 0.001) ;此处意在减小刷新频率
    •           (progn
    •             (command "move" ss "" "_non" p0 "_non" pt)
    •             (if (and (<= f3 16384) (> f3 0))
    •               (setq p0 (osnappt ss (ssmpt ss)))
    •               (setq p0 pt)
    •             )
    •           )
    •         )
    •       )
    •       ((member bb '((2 9)))      ;;table 键
    •         (command "ROTATE" ss "" "_non" pt 90)
    •         ;(setq ss (sl-wzgz ss))
    •       )
    •       ((member bb '((2 65) (2 97)))   ;;A 旋转定角
    •         (command "ROTATE" ss "" "_non" pt pause)
    •         ;(setq ss (sl-wzgz ss))
    •       )
    •       ((member bb '((2 115) (2 83)))  ;;S s 上下翻
    •         (command "mirror" ss "" "_non" pt (mapcar '- pt '(1 0)) "Y")
    •       )
    •       ((member bb '((2 100) (2 68))) ;;D d 左右翻
    •         (command "mirror" ss "" "_non" pt (mapcar '- pt '(0 1)) "Y")
    •       )
    •       ((or (member bb '((2 13))) (= (car bb) 3));;左键、回车
    •         (if (= k t) ;;移动
    •           (setq loop nil)
    •           (progn
    •             (command "copy" ss "" "_non" '(0 0) "_non" '(0 0))
    •             (setq ang (angle pt1 pt) dis (distance pt1 pt) pt1 pt)
    •           )
    •         )
    •       )
    •       ((member bb '((2 67) (2 99)))   ;;C c 复制在当前
    •         (command "copy" ss "" "_non" '(0 0) "_non" '(0 0))
    •         (setq ang (angle pt1 pt) dis (distance pt1 pt) pt1 pt)
    •       )
    •       ((member bb '((2 32))) ;;空格键
    •         (command "copy" ss "" "_non" '(0 0) "_non" '(0 0))
    •         (command "MOVE" ss "" "_non" pt1 "_non" (setq pt1 (polar pt1 ang dis))) ;;移位
    •       )
    •       ((member bb '((2 87) (2 119)))         ;;缩小  W w
    •         (command "scale" ss "" "_non" pt "0.9")
    •       )
    •       ((member bb '((2 81) (2 113)))         ;;放大  Q q
    •         (command "scale" ss "" "_non" pt "1.1")
    •       )
    •       ((equal bb '(2 45))         ;;缩小一半 -
    •         (command "scale" ss "" "_non" pt "0.5")
    •       )
    •       ((member bb '((2 43) (2 61))) ;;放大一倍 +
    •         (command "scale" ss "" "_non" pt "2.0")
    •       )
    •       ;((member bb '((2 90) (2 122)))  ;; 递增 Z z
    •       ;  (setq ss (ss++ ss 1))
    •       ;)
    •       ;((member bb '((2 74) (2 106)))  ;; 递减 J j
    •       ;  (setq ss (ss++ ss -1))
    •       ;)
    •       ((or t (member (car bb) '(11 25)));;右键 其余键
    •         (if (= k t) ;;移动
    •           (command "MOVE" ss "" "_non" pt "_non" p0)  ;;移回去
    •           (sl:-erase ss)
    •         )
    •         (setq loop nil)
    •       )
    •     )
    •   )
    •   (redraw)
    •   (command "_.undo" "e")
    •   ;;;(mapcar 'eval e_lst)
    •   (princ)
    • )
    • ;;对以下扑捉函数,需要再提高点位准确性,也是遗憾之
    • ;;grread图元捕捉子函数-----(一级)------
    • ;;name为移动的图元、选择集,pt为光标点
    • ;;有捕捉点则返回捕捉点,无返回光标点
    • (defun osnappt (name pt / color d h k lst nearpt p0 osmo pt1 pt2 pt3 pt4 pt5 ptx pty x)
    •   (cond
    •     ((= (type name) 'ENAME) (entdel name)) ;图元先删除
    •     ((= (type name) 'PICKSET) ;选择集
    •       (sl-sel-redrawsel name 2) ;先隐藏
    •     )
    •   )
    •   (redraw)
    •   (if (< (getvar "OSMODE") 16384) ;;打开捕捉
    •     (progn
    •       (setq color (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences *Acad*)))
    •         h (p2uu 1.0) d (getvar "PICKBOX")
    •         lst (list (* d h) (* (- d 0.5) h) (* (+ d 0.5) h)) k (* 1.5 d h)
    •       )
    •       (if (setq nearpt (osnap pt "_END,_CEN,_NOD,_QUA,_INS,_PER,_TAN,_APP,_EXT,_PAR"))
    •         (setq osmo 1)
    •       )
    •       (if (and (setq p0 (osnap pt "_NEA")) (not (equal nearpt p0 k)))
    •         (setq osmo 2 nearpt p0)
    •       )
    •       (if (and (setq p0 (osnap pt "_MID")) (equal nearpt p0 k))
    •         (setq osmo 3 nearpt p0)
    •       )
    •       (if (and (setq p0 (osnap pt "_INT")) (equal nearpt p0 k))
    •         (setq osmo 4 nearpt p0)
    •       )
    •     )
    •   )
    •   (cond
    •     ((= (type name) 'ENAME) (entdel name)) ;图元恢复
    •     ((= (type name) 'PICKSET) ;选择集
    •       (sl-sel-redrawsel name 1) ;恢复显示
    •     )
    •   )
    •   (if nearpt
    •     (progn
    •       (setq ptx (car nearpt) pty (cadr nearpt))
    •       (foreach x lst
    •         (setq pt1 (list (- ptx x) (- pty x)) pt2 (list (+ ptx x) (- pty x))
    •           pt3 (list (+ ptx x) (+ pty x)) pt4 (list (- ptx x) (+ pty x))
    •           pt5 (list ptx (+ pty x))
    •         )
    •         (cond
    •           ((= osmo 1) (grvecs (list color pt1 pt2 pt2 pt3 pt3 pt4 pt4 pt1)))
    •           ((= osmo 2) (grvecs (list color pt1 pt2 pt2 pt4 pt3 pt4 pt3 pt1)))
    •           ((= osmo 3) (grvecs (list color pt1 pt2 pt2 pt5 pt5 pt1)))
    •           ((= osmo 4) (grvecs (list color pt1 pt3 color pt2 pt4)))
    •         )
    •       )
    •       (setq pt nearpt)
    •     )
    •   )
    •   pt
    • )
    • ;;重画选择集中的对象-----(一级)-----
    • ;;Sel为选择集或图元名; mode为方式码
    • ;;mode 1 在屏幕重画该选择集对象
    • ;;mode 2 隐藏该选择集对象
    • ;;mode 3 <醒目显示> 该选择集对象
    • ;;mode 4 取消<醒目显示>该选择集对象
    • (defun sl-sel-redrawsel (sel mode / n)
    •   (if sel
    •     (cond
    •       ((= 'PICKSET (type sel))
    •         (repeat (setq n (sslength sel))
    •           (redraw (ssname sel (setq n (1- n))) mode)
    •         )
    •       )
    •       ((= 'ENAME (type sel))
    •         (redraw sel mode)
    •       )
    •     )
    •   )
    •   t
    • )
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-25 05:38 , Processed in 0.189803 second(s), 22 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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