你有种再说一遍 发表于 2024-6-30 18:00
还好c#没有这个烦恼,直接用键盘钩子想怎么玩怎么玩...
cad版本可谓是一点都不重要的问题...一套代码各处编译就行了...
凑热闹（动图有点大，耐心等待）
纯LSP重写带捕捉的grread，支持各种捕捉(含象限点)、极轴、正交、延长线、让低版本CAD也能捕捉几何中心
捕捉的坐标应该没问题，动图中已经放大到小数点后第五位
本帖最后由 gzxl 于 2024-7-3 00:25 编辑
你有种再说一遍 发表于 2024-7-1 01:45
cad版本可谓是一点都不重要的问题...一套代码各处编译就行了...
哈哈，惊神这下遇到语言不通了。
有一事说一事，lisp 调用是什么， AutoCADNET 调用的是什么？
CAD 为什么要分多么多版本也是这么来的。
本帖最后由 尘缘一生 于 2024-7-3 00:13 编辑
dtucad 发表于 2024-7-2 23:53
凑热闹（动图有点大，耐心等待）
纯LSP重写带捕捉的grread，支持各种捕捉(含象限点)、极轴、正交、 ...
你弄好了代码了？我还在考虑，今天又改写了下子，
我那边开了个新帖，为解决这个问题
我没有在函数本身解决问题，构造了个外壳，
;;grread图元捕捉函数-----(一级)------
;;name为移动的图元、选择集,pt为光标点
;;有捕捉点则返回捕捉点,无返回光标点
(defun sl-osnappt (pt / p mode osmod osmode size cl)
(defun sldectobin (n m / c f) ;;十进制转二进制
(setq f (if (< n 0) 1 0) n (abs n))
(while (> (setq c (cons (rem n 2) c) n (* n 0.5)) 0))
(while (< (length c) (1- m)) (setq c (cons 0 c)))
(cons f c)
)
;;------------------
(defun sldrawvecs (pt vecs size cl / xdir)
(setq xdir (getvar 'ucsxdir)
vecs (mapcar '(lambda (x) (mapcar '(lambda (a) (mapcar '+ pt (mapcar '* (setq a (trans a 0 xdir) a (list (caddr a) (car a))) (list size size)))) x)) vecs)
)
(grvecs (apply 'append (mapcar 'cons (mapcar (function (lambda (x) cl)) vecs) vecs)))
)
;;------------------
(if (setq
size (* (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) (getvar "PICKBOX"))
cl (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences *Acad*)))
osmod '("_NEA," "_QUA," "_END," "_MID," "_CEN," "_NOD," "_INT," "_INS," "_PER," "_TAN," "_APP," "_EXT," "_PAR")
osmode (reverse (sldectobin (getvar 'osmode) 1))
p (osnap pt (apply 'strcat (mapcar '(lambda (x y) (if (zerop x) "" y)) osmode osmod)))
mode (cdr (assoc (if p
(vl-some '(lambda (x) (if (equal p (cdr x) 1e-8) (car x)))
(vl-remove 'nil (mapcar '(lambda (x y / p) (if (zerop x) nil (if (setq p (osnap pt y)) (cons y p)))) osmode osmod)))
)
'(("_END," ((-1 1)(-1 -1))((-1 -1)(1 -1))((1 -1) (1 1))((1 1) (-1 1)))
("_MID," ((0 1.414) (-1.225 -0.707)) ((-1.225 -0.707)(1.225 -0.707))((1.225 -0.707) (0 1.414)))
("_CEN," ((0 1) (-0.707 0.707))((-0.707 0.707)(-1 0))((-1 0) (-0.707 -0.707))((-0.707 -0.707)(0 -1))
((0 -1)(0.707 -0.707))((0.707 -0.707)(1 0)) ((1 0) (0.707 0.707))((0.707 0.707) (0 1)))
("_NOD," ((0 1) (-0.707 0.707))((-0.707 0.707)(-1 0))((-1 0)(-0.707 -0.707))((-0.707 -0.707)(0 -1))((0 -1)(0.707 -0.707))
((0.707 -0.707)(1 0))((1 0)(0.707 0.707))((0.707 0.707)(0 1))((-1 1)(1 -1))((-1 -1)(1 1)))
("_QUA," ((0 1.414)(-1.414 0))((-1.414 0)(0 -1.414))((0 -1.414)(1.414 0))((1.414 0)(0 1.414)))
("_INT," ((-1 1)(1 -1))((-1 -1)(1 1))((1 0.859)(-0.859 -1))((-1 0.859)(0.859 -1))((0.859 1)(-1 -0.859))((-0.859 1)(1 -0.859))) ;X
("_INS," ((-1 1)(-1 -0.1))((-1 -0.1)(0 -0.1))((0 -0.1)(0 -1.0))((0 -1.0)(1 -1))
((1 -1)(1 0.1))((1 0.1)(0 0.1))((0 0.1) (0 1.0))((0 1.0)(-1 1))) ;双方形
("_PER," ((-1 1)(-1 -1))((-1 -1)(1 -1))((0 -1)(0 0))((0 0)(-1 0)))
("_TAN," ((0 1)(-0.707 0.707))((-0.707 0.707)(-1 0))((-1 0)(-0.707 -0.707))((-0.707 -0.707)(0 -1))
((0 -1)(0.707 -0.707))((0.707 -0.707)(1 0))((1 0)(0.707 0.707))((0.707 0.707)(0 1))((1 1)(-1 1)))
("_NEA," ((-1 1)(1 -1))((1 -1)(-1 -1))((-1 -1)(1 1))((1 1)(-1 1)))
("_APP," ((-1 1)(-1 -1))((-1 -1)(1 -1))((1 -1)(1 1))((1 1)(-1 1))((-1 1)(1 -1))((-1 -1)(1 1)))
("_EXT," ((0.1 0)(0.13 0))((0.2 0)(0.23 0))((0.3 0)(0.33 0)))
("_PAR" ((0 1)(-1 -1))((1 1)(0 -1)))
)
)
)
)
(sldrawvecs (setq p (if p p pt)) mode size cl)
)
(if p p pt)
)
;;grread图元捕捉子函数-----(一级)------
;;name为移动的图元、选择集,pt为光标点
;;有捕捉点则返回捕捉点,无返回光标点
;;三领设计 尘缘一生 QQ:15290049
(defun slosnappt (name pt / p0 p1 p2 newe ss size k)
(if (< (getvar "OSMODE") 16384) ;;打开捕捉
(progn
(if name (progn (sl-sel-redrawsel name 2) (setq k t))) ;隐藏
(if (setq newe (car (nentselp pt)))
(progn
(setq size (* (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) (getvar "PICKBOX"))
p0 (e9pt newe 5)
ss (ssget "C" (polar p0 5pi4 size) (polar p0 pi4 size))
)
(if (or (null ss) (and ss (< (sslength ss) 2)))
(progn
(setq p1 (polar p0 pi size) p2 (polar p0 0 size))
(entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "f-i-n-d")))
(setq p1 (polar p0 pi2 size) p2 (polar p0 3pi2 size))
(entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "f-i-n-d")))
)
)
)
)
(vl-catch-all-apply '(lambda () (setq pt (sl-osnappt pt))))
(if k (sl-sel-redrawsel name 1)) ;恢复显示
)
)
pt
)
最后就是 三领设计 的广告 :lol
页:
1
[2]