Grread+F3+F8 的事
本帖最后由 尘缘一生 于 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
[*])
页:
[1]