grread下的扑捉问题（已支持象限扑捉）

尘缘一生 · 发表于 2024-7-23 11:02:42

本帖最后由尘缘一生于 2024-7-23 13:26 编辑

最终结果

;;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为光标点
;;有捕捉点则返回捕捉点,无返回光标点
(defun slosnappt (name pt / p0 p1 p2 newe ss size k cl d)
(setq d (getvar "OSMODE"))
(if (and (< d 16384) (> d 0));;打开捕捉
(progn
(if name (progn (setq k t)(sl-sel-redrawsel name 2))) ;隐藏
(setq size (* (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) (getvar "PICKBOX")))
(if (setq ss (ssget "C" (polar pt 5pi4 size) (polar pt pi4 size)))
(progn
(setq newe (ssname ss 0)
p0 (e9pt newe 5)
ss (ssget "C" (polar p0 5pi4 size) (polar p0 pi4 size))
)
(if (and (or (null ss) (and ss (< (sslength ss) 2))) (> (distance p0 pt) (* 10.0 size)))
(progn
(if ss
(setq cl (abs (- 250 (sl-getcolor (ssname ss 0)))))
(setq cl (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences *Acad*))))
)
(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") (cons 62 cl)))
(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") (cons 62 cl)))
)
)
)
)
(setq pt (sl-osnappt pt))
(if k (sl-sel-redrawsel name 1)) ;恢复显示
)
)
pt
)

;;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为光标点 
;;有捕捉点则返回捕捉点,无返回光标点 
(defun slosnappt (name pt / p0 p1 p2 newe ss size k cl d) 
  (setq d (getvar "OSMODE")) 
  (if (and (< d 16384) (> d 0));;打开捕捉 
    (progn 
      (if name (progn (setq k t)(sl-sel-redrawsel name 2))) ;隐藏 
      (setq size (* (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) (getvar "PICKBOX"))) 
      (if (setq ss (ssget "C" (polar pt 5pi4 size) (polar pt pi4 size))) 
        (progn 
          (setq newe (ssname ss 0) 
            p0 (e9pt newe 5) 
            ss (ssget "C" (polar p0 5pi4 size) (polar p0 pi4 size)) 
          ) 
          (if (and (or (null ss) (and ss (< (sslength ss) 2))) (> (distance p0 pt) (* 10.0 size))) 
            (progn 
              (if ss 
                (setq cl (abs (- 250 (sl-getcolor (ssname ss 0))))) 
                (setq cl (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences *Acad*)))) 
              ) 
              (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") (cons 62 cl))) 
              (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") (cons 62 cl))) 
            ) 
          ) 
        ) 
      ) 
      (setq pt (sl-osnappt pt)) 
      (if k (sl-sel-redrawsel name 1)) ;恢复显示 
    ) 
  ) 
  pt 
)

函数看字眼就知道是个啥，自理去即可，我发的是“理念”，就是问题是个啥子，不是代码本身，代码本身没什么意思，会写的很多。这个问题，也是有人问我要这个支持，才发现的，就是扑捉时候，要能扑捉到中心支持，要扑捉这个实体的中心定位，扩展这一功能。
如果前面支持，那好，恭喜了，用即可。我得帖子，记住了，不是给外行看的。

尘缘一生 · 发表于 2024-7-23 13:43:37

bai2000 发表于 2024-7-1 07:41
楼主是老当益壮啊，我们都老了，都要注意身体

我是晚上工作，白天睡觉。

尘缘一生 · 发表于 2024-7-23 13:44:43

sniper1111 发表于 2024-7-1 08:35
睡得太晚了

不是太晚的问题，是我晚上工作。

228378553 · 发表于 2024-7-24 10:56:04

尘缘一生发表于 2024-7-23 11:02
最终结果
函数看字眼就知道是个啥，自理去即可，我发的是“理念”，就是问题是个啥子，不是代码本身 ...

老师你好，我试了缺少函数

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

[讨论] grread下的扑捉问题（已支持象限扑捉）