Grread+F3+F8 的事

尘缘一生 · 发表于 2023-6-26 21:29

本帖最后由尘缘一生于 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
- )

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