grread之历史开发经验剖析

你有种再说一遍

你有种再说一遍 发表于 2024-6-30 18:00
还好c#没有这个烦恼,直接用键盘钩子想怎么玩怎么玩...

cad版本可谓是一点都不重要的问题...一套代码各处编译就行了...

dtucad

凑热闹（动图有点大，耐心等待）
纯LSP重写带捕捉的grread，支持各种捕捉(含象限点)、极轴、正交、延长线、让低版本CAD也能捕捉几何中心
捕捉的坐标应该没问题，动图中已经放大到小数点后第五位

gzxl

你有种再说一遍 发表于 2024-7-1 01:45
cad版本可谓是一点都不重要的问题...一套代码各处编译就行了...

哈哈，惊神这下遇到语言不通了。
有一事说一事，lisp 调用是什么， AutoCADNET 调用的是什么？

CAD 为什么要分多么多版本也是这么来的。

尘缘一生

dtucad 发表于 2024-7-2 23:53
凑热闹（动图有点大，耐心等待）
纯LSP重写带捕捉的grread，支持各种捕捉(含象限点)、极轴、正交、 ...

你弄好了代码了？我还在考虑，今天又改写了下子，
我那边开了个新帖，为解决这个问题
我没有在函数本身解决问题，构造了个外壳，

2. ;;grread图元捕捉函数-----(一级)------
   
3. ;;name为移动的图元、选择集,pt为光标点
   
4. ;;有捕捉点则返回捕捉点,无返回光标点
   
5. (defun sl-osnappt (pt / p mode osmod osmode size cl)
   
6.   (defun sldectobin (n m / c f) ;;十进制转二进制
   
7.     (setq f (if (< n 0) 1 0) n (abs n))
   
8.     (while (> (setq c (cons (rem n 2) c) n (* n 0.5)) 0))
   
9.     (while (< (length c) (1- m)) (setq c (cons 0 c)))
   
10.     (cons f c)
    
11.   )
    
12.   ;;------------------
    
13.   (defun sldrawvecs (pt vecs size cl / xdir)
    
14.     (setq xdir (getvar 'ucsxdir)
    
15.       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)
    
16.     )
    
17.     (grvecs (apply 'append (mapcar 'cons (mapcar (function (lambda (x) cl)) vecs) vecs)))
    
18.   )
    
19.   ;;------------------
    
20.   (if (setq
    
21.         size (* (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) (getvar "PICKBOX"))
    
22.         cl (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences *Acad*)))
    
23.         osmod '("_NEA," "_QUA," "_END," "_MID," "_CEN," "_NOD," "_INT," "_INS," "_PER," "_TAN," "_APP," "_EXT," "_PAR")
    
24.         osmode (reverse (sldectobin (getvar 'osmode) 1))
    
25.         p (osnap pt (apply 'strcat (mapcar '(lambda (x y) (if (zerop x) "" y)) osmode osmod)))
    
26.         mode (cdr (assoc (if p
    
27.                            (vl-some '(lambda (x) (if (equal p (cdr x) 1e-8) (car x)))
    
28.                              (vl-remove 'nil (mapcar '(lambda (x y / p) (if (zerop x) nil (if (setq p (osnap pt y)) (cons y p)))) osmode osmod)))
    
29.                          )
    
30.                     '(("_END," ((-1 1)(-1 -1))((-1 -1)(1 -1))((1 -1) (1 1))((1 1) (-1 1)))
    
31.                        ("_MID," ((0 1.414) (-1.225 -0.707)) ((-1.225 -0.707)(1.225 -0.707))((1.225 -0.707) (0 1.414)))
    
32.                        ("_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))
    
33.                          ((0 -1)(0.707 -0.707))((0.707 -0.707)(1 0)) ((1 0) (0.707 0.707))((0.707 0.707) (0 1)))
    
34.                        ("_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))
    
35.                          ((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)))
    
36.                        ("_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)))
    
37.                        ("_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
    
38.                        ("_INS," ((-1 1)(-1 -0.1))((-1 -0.1)(0 -0.1))((0 -0.1)(0 -1.0))((0 -1.0)(1 -1))
    
39.                          ((1 -1)(1 0.1))((1 0.1)(0 0.1))((0 0.1) (0 1.0))((0 1.0)(-1 1))) ;双方形
    
40.                        ("_PER," ((-1 1)(-1 -1))((-1 -1)(1 -1))((0 -1)(0 0))((0 0)(-1 0)))
    
41.                        ("_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))
    
42.                          ((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)))
    
43.                        ("_NEA," ((-1 1)(1 -1))((1 -1)(-1 -1))((-1 -1)(1 1))((1 1)(-1 1)))
    
44.                        ("_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)))
    
45.                        ("_EXT," ((0.1 0)(0.13 0))((0.2 0)(0.23 0))((0.3 0)(0.33 0)))
    
46.                        ("_PAR" ((0 1)(-1 -1))((1 1)(0 -1)))
    
47.                      )
    
48.                   )
    
49.              )
    
50.       )
    
51.     (sldrawvecs (setq p (if p p pt)) mode size cl)
    
52.   )
    
53.   (if p p pt)
    
54. )
    
55. ;;grread图元捕捉子函数-----(一级)------
    
56. ;;name为移动的图元、选择集,pt为光标点
    
57. ;;有捕捉点则返回捕捉点,无返回光标点
    
58. ;;三领设计 尘缘一生 QQ:15290049
    
59. (defun slosnappt (name pt / p0 p1 p2 newe ss size k)
    
60.   (if (< (getvar "OSMODE") 16384) ;;打开捕捉
    
61.     (progn
    
62.       (if name (progn (sl-sel-redrawsel name 2) (setq k t))) ;隐藏
    
63.       (if (setq newe (car (nentselp pt)))
    
64.         (progn
    
65.           (setq size (* (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) (getvar "PICKBOX"))
    
66.             p0 (e9pt newe 5)
    
67.             ss (ssget "C" (polar p0 5pi4 size) (polar p0 pi4 size))
    
68.           )
    
69.           (if (or (null ss) (and ss (< (sslength ss) 2)))
    
70.             (progn
    
71.               (setq p1 (polar p0 pi size) p2 (polar p0 0 size))
    
72.               (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "f-i-n-d")))
    
73.               (setq p1 (polar p0 pi2 size) p2 (polar p0 3pi2 size))
    
74.               (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "f-i-n-d")))
    
75.             )
    
76.           )
    
77.         )
    
78.       )
    
79.       (vl-catch-all-apply '(lambda () (setq pt (sl-osnappt pt))))
    
80.       (if k (sl-sel-redrawsel name 1)) ;恢复显示
    
81.     )
    
82.   )
    
83.   pt
    
84. )

;;grread图元捕捉函数-----(一级)------<br /> ;;name为移动的图元、选择集,pt为光标点<br /> ;;有捕捉点则返回捕捉点,无返回光标点<br /> (defun sl-osnappt (pt / p mode osmod osmode size cl)<br />   (defun sldectobin (n m / c f) ;;十进制转二进制<br />     (setq f (if (< n 0) 1 0) n (abs n))<br />     (while (> (setq c (cons (rem n 2) c) n (* n 0.5)) 0))<br />     (while (< (length c) (1- m)) (setq c (cons 0 c)))<br />     (cons f c)<br />   )<br />   ;;------------------<br />   (defun sldrawvecs (pt vecs size cl / xdir)<br />     (setq xdir (getvar 'ucsxdir)<br />       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)<br />     )<br />     (grvecs (apply 'append (mapcar 'cons (mapcar (function (lambda (x) cl)) vecs) vecs)))<br />   )<br />   ;;------------------<br />   (if (setq <br />         size (* (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) (getvar "PICKBOX"))<br />         cl (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences *Acad*)))<br />         osmod '("_NEA," "_QUA," "_END," "_MID," "_CEN," "_NOD," "_INT," "_INS," "_PER," "_TAN," "_APP," "_EXT," "_PAR")<br />         osmode (reverse (sldectobin (getvar 'osmode) 1))<br />         p (osnap pt (apply 'strcat (mapcar '(lambda (x y) (if (zerop x) "" y)) osmode osmod)))<br />         mode (cdr (assoc (if p <br />                            (vl-some '(lambda (x) (if (equal p (cdr x) 1e-8) (car x)))<br />                              (vl-remove 'nil (mapcar '(lambda (x y / p) (if (zerop x) nil (if (setq p (osnap pt y)) (cons y p)))) osmode osmod)))<br />                          )<br />                     '(("_END," ((-1 1)(-1 -1))((-1 -1)(1 -1))((1 -1) (1 1))((1 1) (-1 1)))<br />                        ("_MID," ((0 1.414) (-1.225 -0.707)) ((-1.225 -0.707)(1.225 -0.707))((1.225 -0.707) (0 1.414)))<br />                        ("_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))<br />                          ((0 -1)(0.707 -0.707))((0.707 -0.707)(1 0)) ((1 0) (0.707 0.707))((0.707 0.707) (0 1)))<br />                        ("_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))<br />                          ((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)))<br />                        ("_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)))<br />                        ("_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 <br />                        ("_INS," ((-1 1)(-1 -0.1))((-1 -0.1)(0 -0.1))((0 -0.1)(0 -1.0))((0 -1.0)(1 -1)) <br />                          ((1 -1)(1 0.1))((1 0.1)(0 0.1))((0 0.1) (0 1.0))((0 1.0)(-1 1))) ;双方形<br />                        ("_PER," ((-1 1)(-1 -1))((-1 -1)(1 -1))((0 -1)(0 0))((0 0)(-1 0)))<br />                        ("_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))<br />                          ((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)))<br />                        ("_NEA," ((-1 1)(1 -1))((1 -1)(-1 -1))((-1 -1)(1 1))((1 1)(-1 1)))<br />                        ("_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)))<br />                        ("_EXT," ((0.1 0)(0.13 0))((0.2 0)(0.23 0))((0.3 0)(0.33 0)))<br />                        ("_PAR" ((0 1)(-1 -1))((1 1)(0 -1)))<br />                      )<br />                   )<br />              )<br />       )<br />     (sldrawvecs (setq p (if p p pt)) mode size cl)<br />   )<br />   (if p p pt)<br /> )<br /> ;;grread图元捕捉子函数-----(一级)------<br /> ;;name为移动的图元、选择集,pt为光标点<br /> ;;有捕捉点则返回捕捉点,无返回光标点<br /> ;;三领设计 尘缘一生 QQ:15290049<br /> (defun slosnappt (name pt / p0 p1 p2 newe ss size k)<br />   (if (< (getvar "OSMODE") 16384) ;;打开捕捉<br />     (progn <br />       (if name (progn (sl-sel-redrawsel name 2) (setq k t))) ;隐藏<br />       (if (setq newe (car (nentselp pt)))<br />         (progn <br />           (setq size (* (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) (getvar "PICKBOX"))<br />             p0 (e9pt newe 5)<br />             ss (ssget "C" (polar p0 5pi4 size) (polar p0 pi4 size))<br />           )<br />           (if (or (null ss) (and ss (< (sslength ss) 2)))<br />             (progn <br />               (setq p1 (polar p0 pi size) p2 (polar p0 0 size))<br />               (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "f-i-n-d")))<br />               (setq p1 (polar p0 pi2 size) p2 (polar p0 3pi2 size))<br />               (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "f-i-n-d")))<br />             )<br />           )<br />         )<br />       )<br />       (vl-catch-all-apply '(lambda () (setq pt (sl-osnappt pt))))<br />       (if k (sl-sel-redrawsel name 1)) ;恢复显示<br />     )<br />   )<br />   pt<br /> )

gzcsun

最后就是 三领设计 的广告