设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › grread下的扑捉问题（已支持象限扑捉）
返回列表 发新帖
查看: 288|回复: 6

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

[复制链接]
尘缘一生
发表于 2024-6-30 23:47 | 显示全部楼层 |阅读模式
本帖最后由 尘缘一生 于 2024-7-1 09:57 编辑

新开一贴，对于这个问题，希望在本帖要解决了它，
什么问题呢？那就是，grread下支持扑捉象限点，这个问题
请大家移步先看技术帖子，再来进一步的研究...
顾版的
http://bbs.mjtd.com/forum.php?mo ... 91&highlight=grread
廊大师的
http://bbs.mjtd.com/forum.php?mo ... 90&highlight=grread

下面代码，是我今上午改写的，尝试一下，还不完美，
  2. ;;grread图元捕捉子函数-----(一级)------有缺憾，会闪烁
  3. ;;name为移动的图元、选择集，pt为光标点
  4. ;;有捕捉点则返回捕捉点，无返回光标点
  5. (defun slosnappt (name pt / cl osmo d h k lst nearpt p0 p00 p1 p2 p3 p4 p5 ptx pty x newe)
  6.   (redraw)
  7.   (if (< (getvar "OSMODE") 16384) ;;打开捕捉
  8.     (progn
  9.       (cond
  10.         ((= (type name) 'ENAME) (entdel name)) ;图元先删除
  11.         ((= (type name) 'PICKSET) ;选择集
  12.           (sl-sel-redrawsel name 2) ;先隐藏
  13.         )
  14.       )
  15.       (setq
  16.         p1 nil p2 nil
  17.         cl (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences *Acad*)))
  18.         h (p2uu 1.0) d (getvar "PICKBOX")
  19.         lst (list (* d h) (* (- d 0.5) h) (* (+ d 0.5) h)) k (* 30.0 d h)
  20.         p1 (cadr (grread 5))
  21.       )
  22.       ;下面三行，此时如果扑捉到实体，取得它中心p2
  23.       (if (setq newe (car (nentselp pt)))
  24.         (setq p2 (e-mid newe))
  25.       )
  26.       ;;这是第一步，取得扑捉点
  27.       (if (setq p0 (osnap pt "_NEA,_MID,_END,_INT,_CEN,_NOD,_QUA,_INS,_PER,_TAN,_APP,_EXT,_PAR"))
  28.         (setq osmo 1 nearpt p0)
  29.       )
  30.       ;;如果是NEA  只不过是判定osmo罢了吗？值得进行下去if，如果能模拟到和CAD一样丝滑，建议osmo仅仅一个好了，那就是osmo=1 ,画个矩形
  31.       (if (and (setq p0 (osnap pt "_NEA")) (equal nearpt p0 k))
  32.         (setq osmo 2 nearpt p0)
  33.       )
  34.       (if (and (setq p0 (osnap pt "_MID")) (equal nearpt p0 k))
  35.         (setq osmo 3 nearpt p0)
  36.       )
  37.       (if (and (setq p0 (osnap pt "_INT")) (equal nearpt p0 k))
  38.         (setq osmo 4 nearpt p0)
  39.       )
  40.       ;;下面三句吗，我尝试给于象限点p2，并设为OSMO=4，画交叉矢量线，可以是可以，但是操作不如CAD本身丝滑
  41.       (if (and p2 nearpt (not (equal nearpt p2 k)))
  42.         (setq osmo 4 nearpt p2)
  43.       )
  44.       (cond
  45.         ((= (type name) 'ENAME) (entdel name)) ;图元恢复
  46.         ((= (type name) 'PICKSET) ;选择集
  47.           (sl-sel-redrawsel name 1) ;恢复显示
  48.         )
  49.       )
  50.       (if nearpt
  51.         (progn
  52.           (setq ptx (car nearpt) pty (cadr nearpt))
  53.           (while lst
  54.             (setq x (car lst) p1 (list (- ptx x) (- pty x)) p2 (list (+ ptx x) (- pty x))
  55.               p3 (list (+ ptx x) (+ pty x)) p4 (list (- ptx x) (+ pty x))
  56.               p5 (list ptx (+ pty x))
  57.             )
  58.             (cond
  59.               ((= osmo 1) (grvecs (list cl p1 p2 p2 p3 p3 p4 p4 p1))) ;正方形
  60.               ((= osmo 2) (grvecs (list cl p1 p2 p2 p4 p3 p4 p3 p1))) ;俩三角
  61.               ((= osmo 3) (grvecs (list cl p1 p2 p2 p5 p5 p1))) ;三角
  62.               ((= osmo 4) (grvecs (list cl p1 p3 cl p2 p4)))  ;交叉
  63.             )
  64.             (setq lst (cdr lst))
  65.           )
  66.           (setq pt nearpt)
  67.         )
  68.       )  
  69.     )
  70.   )
  71.   pt
  72. )
下面为了大家能更好的解决这个问题，贴上另一种优秀代码，还没来得及尝试扑捉象限点的改写
  2. ;;重画选择集中的对象-----(一级)-----
  3. ;;Sel为选择集或图元名; mode为方式码
  4. ;;mode 1 在屏幕重画该选择集对象
  5. ;;mode 2 隐藏该选择集对象
  6. ;;mode 3 <醒目显示> 该选择集对象
  7. ;;mode 4 取消<醒目显示>该选择集对象
  8. (defun sl-sel-redrawsel (sel mode / n)
  9.   (if sel
  10.     (cond
  11.       ((= 'PICKSET (type sel))
  12.         (repeat (setq n (sslength sel))
  13.           (redraw (ssname sel (setq n (1- n))) mode)
  14.         )
  15.       )
  16.       ((= 'ENAME (type sel))
  17.         (redraw sel mode)
  18.       )
  19.     )
  20.   )
  21.   t
  22. )
  23. ;;grread图元捕捉子函数-----(一级)------
  24. ;;name为移动的图元、选择集,pt为光标点
  25. ;;有捕捉点则返回捕捉点,无返回光标点
  26. (defun slosnappt (name pt / p mode osmod osmode size k)
  27.   (defun sldectobin (n m / c f) ;;十进制转二进制
  28.     (setq f (if (< n 0) 1 0) n (abs n))
  29.     (while (> (setq c (cons (rem n 2) c) n (* n 0.5)) 0))
  30.     (while (< (length c) (1- m)) (setq c (cons 0 c)))
  31.     (cons f c)
  32.   )
  33.   ;;------------------
  34.   (defun sldrawvecs (pt vecs size cl / xdir)
  35.     (setq xdir (getvar 'ucsxdir)
  36.       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)
  37.     )
  38.     (grvecs (apply 'append (mapcar 'cons (mapcar (function (lambda (x) cl)) vecs) vecs)))
  39.   )
  40.   ;;----------------
  41.   (if (< (getvar "OSMODE") 16384) ;;打开捕捉
  42.     (progn
  43.       (if name (progn (sl-sel-redrawsel name 2) (setq k t))) ;隐藏
  44.       (if (setq
  45.             osmod '("_NEA," "_QUA," "_END," "_MID," "_CEN," "_NOD," "_INT," "_INS," "_PER," "_TAN," "_APP," "_EXT," "_PAR")
  46.             osmode (reverse (sldectobin (getvar 'osmode) 1))
  47.             size (* (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) (getvar "PICKBOX"))
  48.             p (osnap pt (apply 'strcat (mapcar '(lambda (x y) (if (zerop x) "" y)) osmode osmod)))
  49.             mode (cdr (assoc (if p
  50.                                (vl-some '(lambda (x) (if (equal p (cdr x) 1e-8) (car x)))
  51.                                  (vl-remove 'nil (mapcar '(lambda (x y / p) (if (zerop x) nil (if (setq p (osnap pt y)) (cons y p)))) osmode osmod)))
  52.                              )
  53.                         '(("_END," ((-1 1)(-1 -1))((-1 -1)(1 -1))((1 -1) (1 1))((1 1) (-1 1)))
  54.                            ("_MID," ((0 1.414) (-1.225 -0.707)) ((-1.225 -0.707)(1.225 -0.707))((1.225 -0.707) (0 1.414)))
  55.                            ("_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))
  56.                              ((0 -1)(0.707 -0.707))((0.707 -0.707)(1 0)) ((1 0) (0.707 0.707))((0.707 0.707) (0 1)))
  57.                            ("_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))
  58.                              ((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)))
  59.                            ("_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)))
  60.                            ("_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)))
  61.                            ("_INS," ((-1 1)(-1 -0.1))((-1 -0.1)(0 -0.1))((0 -0.1)(0 -1.0))((0 -1.0)(1 -1))
  62.                              ((1 -1)(1 0.1))((1 0.1)(0 0.1))((0 0.1) (0 1.0))((0 1.0)(-1 1)))
  63.                            ("_PER," ((-1 1)(-1 -1))((-1 -1)(1 -1))((0 -1)(0 0))((0 0)(-1 0)))
  64.                            ("_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))
  65.                              ((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)))
  66.                            ("_NEA," ((-1 1)(1 -1))((1 -1)(-1 -1))((-1 -1)(1 1))((1 1)(-1 1)))
  67.                            ("_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)))
  68.                            ("_EXT," ((0.1 0)(0.13 0))((0.2 0)(0.23 0))((0.3 0)(0.33 0)))
  69.                            ("_PAR" ((0 1)(-1 -1))((1 1)(0 -1)))
  70.                          )
  71.                       )
  72.                  )
  73.           )
  74.         (sldrawvecs (setq p (if p p pt)) mode size (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences *Acad*))))
  75.       )
  76.       (if k (sl-sel-redrawsel name 1)) ;恢复显示
  77.     )
  78.   )
  79.   (if p p pt)
  80. )


评分

参与人数 1明经币 +1 收起 理由
baitang36 + 1 师弟是夜猫子类型啊，这么晚了还发帖子

查看全部评分

"觉得好，就打赏"
打赏
还没有人打赏，支持一下
回复

使用道具 举报

bai2000
发表于 2024-7-1 07:41 | 显示全部楼层
楼主是老当益壮啊，我们都老了，都要注意身体
回复 支持 反对

使用道具 举报

sniper1111
发表于 2024-7-1 08:35 | 显示全部楼层
睡得太晚了
回复 支持 反对

使用道具 举报

尘缘一生
 楼主| 发表于 2024-7-1 09:56 | 显示全部楼层
为支持象限扑捉的改写，可以用了
  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 (and p0 p (not (equal p pt size)))
  54.   ;  (progn
  55.   ;    (setq p p0)
  56.   ;    (sldrawvecs p0 '(((-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))) size cl)
  57.   ;  )
  58.   ;)
  59.   (if p p pt)
  60. )
  61. ;;grread图元捕捉函数-----(一级)------
  62. ;;name为移动的图元、选择集,pt为光标点
  63. ;;有捕捉点则返回捕捉点,无返回光标点
  64. ;;支持象限点 三领设计 V3.0 Modify by 尘缘一生  QQ:15290049 2024.7.1  (精简后代码)
  65. (defun slosnappt (name pt / p0 p1 p2 newe size k)
  66.   (if (< (getvar "OSMODE") 16384) ;;打开捕捉
  67.     (progn
  68.       (if name (progn (sl-sel-redrawsel name 2) (setq k t))) ;隐藏
  69.       (if (setq newe (car (nentselp pt)))
  70.         (progn
  71.           (setq p0 (e9pt newe 5))
  72.           (if (= (nentselp p0) nil)
  73.             (progn
  74.               (setq size (* (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) (getvar "PICKBOX")))
  75.               (setq p1 (polar p0 pi size) p2 (polar p0 0 size))
  76.               (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "f-i-n-d"))) ;产生的象限临时线，需在函数体外删除，目前没解决函数体内删除问题
  77.               (setq p1 (polar p0 pi2 size) p2 (polar p0 3pi2 size))
  78.               (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "f-i-n-d"))) ;产生的象限临时线，需在函数体外删除，目前没解决函数体内删除问题
  79.             )
  80.           )
  81.         )
  82.       )
  83.       (setq pt (sl-osnappt pt))
  84.       (if k (sl-sel-redrawsel name 1)) ;恢复显示
  85.     )
  86.   )
  87.   pt
  88. )


回复 支持 反对

使用道具 举报

jun470
发表于 2024-7-1 10:02 | 显示全部楼层
新手前来学习下，grread我现在就只用过一次
回复 支持 反对

使用道具 举报

尘缘一生
 楼主| 发表于 2024-7-3 00:24 | 显示全部楼层
外壳部分再作一下

  2. ;;grread图元捕捉子函数-----(一级)------
  3. ;;name为移动的图元、选择集,pt为光标点
  4. ;;有捕捉点则返回捕捉点,无返回光标点
  5. ;;三领设计 尘缘一生 QQ:15290049
  6. (defun slosnappt (name pt / p0 p1 p2 newe ss size k)
  7.   (if (< (getvar "OSMODE") 16384) ;;打开捕捉
  8.     (progn
  9.       (if name (progn (sl-sel-redrawsel name 2) (setq k t))) ;隐藏
  10.       (if (setq newe (car (nentselp pt)))
  11.         (progn
  12.           (setq size (* (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) (getvar "PICKBOX"))
  13.             p0 (e9pt newe 5)
  14.             ss (ssget "C" (polar p0 5pi4 size) (polar p0 pi4 size))
  15.           )
  16.           (if (or (null ss) (and ss (< (sslength ss) 2)))
  17.             (progn
  18.               (setq p1 (polar p0 pi size) p2 (polar p0 0 size))
  19.               (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "f-i-n-d")))
  20.               (setq p1 (polar p0 pi2 size) p2 (polar p0 3pi2 size))
  21.               (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "f-i-n-d")))
  22.             )
  23.           )
  24.         )
  25.       )
  26.       (vl-catch-all-apply '(lambda () (setq pt (sl-osnappt pt))))
  27.       (if k (sl-sel-redrawsel name 1)) ;恢复显示
  28.     )
  29.   )
  30.   pt
  31. )


回复 支持 反对

使用道具 举报

尘缘一生
 楼主| 发表于 2024-7-4 01:16 | 显示全部楼层
  2. ;;;返回捕捉模式字串
  3. ;"_END,_MID,_CEN,_NOD,_QUA,_INT,_INS,_PER,_TAN,_NEA,_QUI,_APP,_EXT,_PAR"
  4. (defun get_osmode (/ cur_mode mode) ;(get_osmode)
  5.   (setq mode "")
  6.   (if (< 0 (setq cur_mode (getvar "osmode")) 16384)
  7.     (mapcar
  8.       (function
  9.         (lambda (x)
  10.           (if (not (zerop (logand cur_mode (car x))))
  11.             (if (zerop (strlen mode))
  12.               (setq mode (cadr x))
  13.               (setq mode (strcat mode "," (cadr x)))
  14.             )
  15.           )
  16.         )
  17.       )
  18.       '((1 "_END")
  19.          (2 "_MID")
  20.          (4 "_CEN")
  21.          (8 "_NOD")
  22.          (16 "_QUA")
  23.          (32 "_INT")
  24.          (64 "_INS")
  25.          (128 "_PER")
  26.          (256 "_TAN")
  27.          (512 "_NEA")
  28.          (1024 "_QUI")
  29.          (2048 "_APP")
  30.          (4096 "_EXT")
  31.          (8192 "_PAR")
  32.        )
  33.     )
  34.   )
  35.   mode
  36. )
  37. ;;grread图元捕捉子函数-----(一级)------有缺憾，会闪烁
  38. ;;name为移动的图元、选择集，pt为光标点
  39. ;;有捕捉点则返回捕捉点，无返回光标点
  40. (defun slosnappt (name pt / cl osmo d h k kk lst nearpt p0 p00 p1 p2 p3 p4 p5 ptx pty x newe)
  41.   (if (< (getvar "OSMODE") 16384) ;;打开捕捉
  42.     (progn
  43.       (if name (progn (sl-sel-redrawsel name 2) (setq kk t))) ;隐藏
  44.       (setq
  45.         p1 nil p2 nil
  46.         cl (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences *Acad*)))
  47.         h (p2uu 1.0) d (getvar "PICKBOX")
  48.         lst (list (* d h) (* (- d 0.5) h) (* (+ d 0.5) h)) k (* 30.0 d h)
  49.         p1 (cadr (grread 5))
  50.       )
  51.       (if (setq newe (car (nentselp pt)))
  52.         (setq p2 (e9pt newe 5))
  53.       )
  54.       (if (setq p0 (osnap pt (get_osmode)))
  55.         (setq osmo 1 nearpt p0)
  56.       )
  57.       (if (and (setq p0 (osnap pt "_NEA")) (equal nearpt p0 k))
  58.         (setq osmo 2 nearpt p0)
  59.       )
  60.       (if (and (setq p0 (osnap pt "_MID")) (equal nearpt p0 k))
  61.         (setq osmo 3 nearpt p0)
  62.       )
  63.       (if (and (setq p0 (osnap pt "_INT")) (equal nearpt p0 k))
  64.         (setq osmo 4 nearpt p0)
  65.       )
  66.       (if (and p2 nearpt (not (equal nearpt p2 k)))
  67.         (setq osmo 4 nearpt p2)
  68.       )
  69.       (if kk (sl-sel-redrawsel name 1)) ;恢复显示
  70.     )
  71.     (if nearpt
  72.       (progn
  73.         (setq ptx (car nearpt) pty (cadr nearpt))
  74.         (while lst
  75.           (setq x (car lst) p1 (list (- ptx x) (- pty x)) p2 (list (+ ptx x) (- pty x))
  76.             p3 (list (+ ptx x) (+ pty x)) p4 (list (- ptx x) (+ pty x))
  77.             p5 (list ptx (+ pty x))
  78.           )
  79.           (cond
  80.             ((= osmo 1) (grvecs (list cl p1 p2 p2 p3 p3 p4 p4 p1))) ;正方形
  81.             ((= osmo 2) (grvecs (list cl p1 p2 p2 p4 p3 p4 p3 p1))) ;俩三角
  82.             ((= osmo 3) (grvecs (list cl p1 p2 p2 p5 p5 p1))) ;三角
  83.             ((= osmo 4) (grvecs (list cl p1 p3 cl p2 p4)));交叉
  84.           )
  85.           (setq lst (cdr lst))
  86.         )
  87.         (setq pt nearpt)
  88.       )
  89.     )
  90.   )
  91.   pt
  92. )


回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-7-4 11:48 , Processed in 0.169042 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表