判断鼠标移动点是否从直线的一侧变成另一侧

被承包的东子

今天写了一个判断函数，用来判断一个鼠标点是否从直线的一侧移动到了另外一侧，写完了确实能达到效果，但是总感觉判断的逻辑太low，因为不知道怎么用准确的描述去搜索论坛里的做法，所以直接贴出来给各位看看，能不能帮我看看怎么改，或者怎么写才能简洁高效，谢谢
以下红代码就是一个判断过程，望各位帮帮忙改进下


(defun c:cs()
(vl-load-com)

(setq en(car (setq en_pt (entsel "\n选择一根直线"))) inpt (cadr en_pt ) ed (entget en))
(setq pt1 (cdr (assoc 10 ed)) pt2 (cdr (assoc 11 ed))  )
(setq mid_pt (mapcar '(lambda (x y) (* 0.5 (+ x y))) pt1 pt2)   )
(if (and pt1 pt2)
(progn
(setq ang_mi (angle pt1 pt2))
(if (< ang_mi pi)
(setq ang_l  ang_mi   ang_h (+ pi ang_mi))
(setq ang_l (-  ang_mi pi)   ang_h ang_mi)
)
(setq inpt2 (Polar mid_pt 0 1))
(setq en_lin2 (entmakex (list '(0 . "LINE") (cons 10 mid_pt) (cons 11 inpt2))))
(setq pt0 (getpoint "\n 点取直线的一侧")   )
(setq ed2 (entget en_lin2)   )
(setq   vlu 0 vlu_2 0)

(while
(and (setq gr (grread 5)) (= (car gr) 5))
(setq gr_pt (cadr gr) gr_ang (angle inpt gr_pt) )
(setq new_pt (cons 11 gr_pt))
(setq ed2 (subst new_pt (Assoc 11 ed2) ed2  ))
(entmod ed2)

(if (< vlu 1)
(cond
((and (< gr_ang ang_h ) (> gr_ang ang_l ))(setq vlu 1))
((or (> gr_ang ang_h ) (< gr_ang ang_l ))(setq vlu 2) )
)
(cond
((and (< gr_ang ang_h ) (> gr_ang ang_l ))(setq vlu_2 1))
((or (> gr_ang ang_h ) (< gr_ang ang_l ))(setq vlu_2 2))
)
)
)

(if (and (> vlu_2 0) (/= vlu_2  vlu))
(princ"\n鼠标点已经跨过直线！")
(princ"\n鼠标点没有跨过直线！")
)
;(princ vlu)
;(princ vlu_2)
(princ)
(entdel en_lin2)
)


)
(princ)
)

晨曦CAD

2. ;;判断两点是否在曲线同侧
   
3. ;@晨曦 2021.3
   
4. ;输入参数：curve --- 曲线 图元名ENAME
   
5. ;          p0    --- 已知的点
   
6. ;          p     --- 需判断的点
   
7. ;输出参数：1 --- p与p0在直线同一侧
   
8. ;          0 --- p与p0不在直线同一侧
   
9. (defun lineside(curve p0 p / re)
   
10.          (if(null (inters p0 p (vlax-curve-getclosestpointto curve p0) (vlax-curve-getclosestpointto curve p)))
    
11.                  ;同侧
    
12.      (setq re 1)
    
13.                  ;两侧
    
14.      (setq re 0))
    
15.         )
    
16. )

;;判断两点是否在曲线同侧<br /> ;@晨曦 2021.3<br /> ;输入参数：curve --- 曲线 图元名ENAME<br /> ;          p0    --- 已知的点<br /> ;          p     --- 需判断的点<br /> ;输出参数：1 --- p与p0在直线同一侧<br /> ;          0 --- p与p0不在直线同一侧<br /> (defun lineside(curve p0 p / re)<br />          (if(null (inters p0 p (vlax-curve-getclosestpointto curve p0) (vlax-curve-getclosestpointto curve p)))<br />                  ;同侧<br />      (setq re 1)<br />                  ;两侧<br />      (setq re 0))<br />         )<br /> )

2. ;测试
   
3. (defun c:tt(/)
   
4.         (setq curve(car(entsel "选择一根直线")))
   
5.         (setq p0(getpoint "\n 点取直线的一侧"))
   
6.         (while (setq p(getpoint))
   
7.                 (if (= (lineside curve p0 p) 1)
   
8.                         (alert "同侧")
   
9.                         (alert "异侧")
   
10.                 )
    
11.                 )
    
12. )

;测试<br /> (defun c:tt(/)<br />         (setq curve(car(entsel "选择一根直线")))<br />         (setq p0(getpoint "\n 点取直线的一侧"))<br />         (while (setq p(getpoint))<br />                 (if (= (lineside curve p0 p) 1)<br />                         (alert "同侧")<br />                         (alert "异侧")<br />                 )<br />                 )<br /> )

被承包的东子

晨曦CAD 发表于 2021-3-13 21:51

构思太妙了，不过有个小bug，如果第二个点与第一点的连线垂直于所选择的直线，那么判断就会出现错误，可能还要加个判断，我想了一个判断逻辑，但是还是不完美，不知道你有没有新的秒点子

Longfin

参考一下我这个帖子：
http://bbs.xdcad.net/thread-727744-1-1.html

1. ;;;--------------------------------------------
   
2. ;;;判断点在曲线方向(正方向、反方向、在曲线上)代码如下：
   
3. ;;;适用包含直线、圆弧、样条曲线的任意曲线
   
4. (defun PT-AtDirOfCurve (E P / P0 V)
   
5.   (setq P0 (vlax-curve-getClosestPointTo E P)
   
6.         V  (vlax-curve-getFirstDeriv E (vlax-curve-getParamAtPoint E P0))
   
7.   )
   
8.   (car (trans (mapcar '- P P0) 0 V))
   
9. )
   

;;;--------------------------------------------<br /> ;;;判断点在曲线方向(正方向、反方向、在曲线上)代码如下：<br /> ;;;适用包含直线、圆弧、样条曲线的任意曲线<br /> (defun PT-AtDirOfCurve (E P / P0 V)<br />   (setq P0 (vlax-curve-getClosestPointTo E P)<br />         V  (vlax-curve-getFirstDeriv E (vlax-curve-getParamAtPoint E P0))<br />   )<br />   (car (trans (mapcar '- P P0) 0 V))<br /> )<br />

;;测试代码1
(defun C:TT1 (/ E GR1 GR2)
  (if (setq E (car (entsel "\n选择封闭曲线: ")))
    (while
      (progn
        (setq GR1 (grread T 15 0)
              GR2 (cadr GR1)
              GR1 (car GR1)
        )
        (if (or (= GR1 5) (= GR1 3))
          (if (> (PT-AtDirOfCurve E GR2) 0)
            (princ "\r在正方向")
            (princ "\r在反方向")
          )
        )
        (not (member GR1 '(3 11)))
      )
    )
  )
  (princ)
)
;;;--------------------------------------------

被承包的东子

Longfin 发表于 2021-3-15 09:25
参考一下我这个帖子：
http://bbs.xdcad.net/thread-727744-1-1.html

谢谢，真是学到知识了

hh_lj007

谢谢大家分享

janshyl

不錯的程式 學習中 感謝樓主分享

hh_lj007

4楼代码已测，有效可用