Grread+F3+F8 的事

尘缘一生

如题，经过磨合，现把 《三领设计 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
  • )