求两线的交点

lucas3 · 发表于 2014-9-9 20:40:47

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 lucas3 于 2014-9-9 21:06 编辑

可以是任意多边形，或是两条直线，选择两条相邻的线，求出交点坐标，这个交点是唯一的，只有一个，论坛有这样的函数吗？

找了一下“两线交点函数”，有这样的函数，但是当我选择一个矩形两条相邻的边，得到的是4个点座标，有没有我要求的那样，只返回唯一的交点座标呢？

不考虑其它曲线，如，圆，圆弧，样条曲线，椭圆，椭圆弧

lgx9612 · 发表于 2014-9-9 21:16:38

矩形或多边形其实就是一个图元而已，你虽然点选了两个相邻的边，其实你是选择了两次同一个图元而已，故有交点四个。

st788796 · 发表于 2014-9-9 21:46:20

取每段起始点然后inters

lucas3 · 发表于 2014-9-9 21:49:45

st788796 发表于 2014-9-9 21:46
取每段起始点然后inters

大师，能不能直接给出函数?感谢!

st788796 · 发表于 2014-9-9 22:54:19

lucas3 发表于 2014-9-9 21:49
大师，能不能直接给出函数?感谢!

如果是pline点一个边的临近交点处就可以找到这个交点，无需另一个边，可以参考XD::polyline:-index+和xd::polyline:nearindex
如果是两个line可用inters也可以用一个线的两个端点判断哪个在另外线上的方法找交点

lgx9612 · 发表于 2014-9-9 23:29:34

本帖最后由 lgx9612 于 2014-9-10 19:21 编辑

请指正

(defun inters_lgx (/ bbb ss_lgx point1_lgx point2_lgx ss1_lgx interpoint loop p1_lgx interpoint_list nofit)
;;;by:刘国新
(setq ss_lgx (entsel "\n选择第一条线:"))
(if ss_lgx
(progn
(setq bbb (entget (car ss_lgx)))
(setq point1_lgx (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car ss_lgx)) (cadr ss_lgx) nil))
(setq ss1_lgx (entsel "\n选择第二条线:"))
)
)
(if ss1_lgx
(if (/= (ssmemb (car ss1_lgx) (ssadd (car ss_lgx))) nil)
(progn
(setq point2_lgx (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car ss1_lgx)) (cadr ss1_lgx) nil))
(setq interpoint (inters point1_lgx (polar point1_lgx (+ (angle (cadr ss_lgx) point1_lgx) (* 0.5 pi)) 5.0)
point2_lgx (polar point2_lgx (+ (angle (cadr ss1_lgx) point2_lgx) (* 0.5 pi)) 5.0) nil))
(setq interpoint (reverse(cdr (reverse interpoint))))
(setq loop t)
(if (/= interpoint nil)
(if (= (cdr (assoc 0 bbb)) "LWPOLYLINE")
(while loop
(if (= (assoc 10 bbb) nil)
(progn
(setq loop nil)
(setq interpoint nil)
)
)
(setq p1_lgx (assoc 10 bbb))
(if (equal interpoint (cdr p1_lgx) 0.0005)
(setq loop nil)
(setq bbb (vl-remove p1_lgx bbb))
)
)
)
)
)
(progn
(setq bbb (vlax-invoke (vlax-ename->vla-object (car ss_lgx)) 'intersectwith (vlax-ename->vla-object (car ss1_lgx)) 0))
(if bbb
(progn
(repeat (/ (length bbb) 3)
(setq interpoint_list (cons (list (car bbb)(cadr bbb)) interpoint_list))
(setq bbb (cdr bbb))
(setq bbb (cdr bbb))
(setq bbb (cdr bbb))
)
(setq point2_lgx (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car ss1_lgx)) (cadr ss1_lgx) nil))
(setq interpoint (inters point1_lgx (polar point1_lgx (+ (angle (cadr ss_lgx) point1_lgx) (* 0.5 pi)) 5.0)
point2_lgx (polar point2_lgx (+ (angle (cadr ss1_lgx) point2_lgx) (* 0.5 pi)) 5.0) nil))
(setq interpoint (reverse(cdr (reverse interpoint))))
(if (/= interpoint nil)
(progn
(while interpoint_list
(setq p1_lgx (car interpoint_list))
(setq interpoint_list (cdr interpoint_list))
(if (equal interpoint p1_lgx 0.0005)
(progn
(setq interpoint_list nil)
(setq nofit nil)
)
(setq nofit 1)
)
)
(if (= nofit 1)
(setq interpoint nil)
)
)
)
)
)
)
)
(princ "选择有误\n")
)
(princ)
interpoint
)

(defun inters_lgx (/ bbb ss_lgx point1_lgx point2_lgx ss1_lgx interpoint loop p1_lgx interpoint_list nofit) 
;;;by:刘国新 
(setq ss_lgx (entsel "\n选择第一条线:")) 
(if ss_lgx 
(progn 
(setq bbb (entget (car ss_lgx))) 
(setq point1_lgx (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car ss_lgx)) (cadr ss_lgx) nil)) 
(setq ss1_lgx (entsel "\n选择第二条线:")) 
) 
) 
(if ss1_lgx 
(if (/= (ssmemb (car ss1_lgx) (ssadd (car ss_lgx))) nil) 
(progn 
(setq point2_lgx (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car ss1_lgx)) (cadr ss1_lgx) nil)) 
(setq interpoint (inters point1_lgx (polar point1_lgx (+ (angle (cadr ss_lgx) point1_lgx) (* 0.5 pi)) 5.0) 
     point2_lgx (polar point2_lgx (+ (angle (cadr ss1_lgx) point2_lgx) (* 0.5 pi)) 5.0) nil)) 
(setq interpoint (reverse(cdr (reverse interpoint)))) 
(setq loop t) 
(if (/= interpoint nil) 
(if (= (cdr (assoc 0 bbb)) "LWPOLYLINE") 
(while loop 
(if (= (assoc 10  bbb) nil) 
(progn 
(setq loop nil) 
(setq interpoint nil) 
) 
) 
(setq p1_lgx (assoc 10  bbb)) 
(if (equal interpoint (cdr p1_lgx) 0.0005) 
(setq loop nil) 
(setq bbb (vl-remove p1_lgx bbb)) 
) 
) 
) 
) 
) 
(progn 
(setq bbb (vlax-invoke (vlax-ename->vla-object (car ss_lgx)) 'intersectwith (vlax-ename->vla-object (car ss1_lgx)) 0)) 
(if bbb 
(progn 
(repeat (/ (length bbb) 3) 
(setq interpoint_list (cons (list (car bbb)(cadr bbb)) interpoint_list)) 
(setq bbb (cdr bbb)) 
(setq bbb (cdr bbb)) 
(setq bbb (cdr bbb)) 
) 
(setq point2_lgx (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car ss1_lgx)) (cadr ss1_lgx) nil)) 
(setq interpoint (inters point1_lgx (polar point1_lgx (+ (angle (cadr ss_lgx) point1_lgx) (* 0.5 pi)) 5.0) 
     point2_lgx (polar point2_lgx (+ (angle (cadr ss1_lgx) point2_lgx) (* 0.5 pi)) 5.0) nil)) 
(setq interpoint (reverse(cdr (reverse interpoint)))) 
(if (/= interpoint nil) 
(progn 
(while interpoint_list 
(setq p1_lgx (car interpoint_list)) 
(setq interpoint_list (cdr interpoint_list)) 
(if (equal interpoint p1_lgx 0.0005) 
(progn 
(setq interpoint_list nil) 
(setq nofit nil) 
) 
(setq nofit 1) 
) 
) 
(if (= nofit 1) 
(setq interpoint nil) 
) 
) 
) 
) 
) 
) 
) 
(princ "选择有误\n") 
) 
(princ) 
interpoint 
)

Free-Lancer · 发表于 2014-9-10 07:36:57

(defun c:tt (/ polyline:lineseg line:point e1 e2 el1 el2 i k p)
(defun polyline:lineseg (e i / p1 p2)
(setq p1 (vlax-curve-getpointatparam e i)
p2 (vlax-curve-getpointatparam e (1+ i))
)
(if (equal (distance p1 p2)
(- (vlax-curve-getdistatpoint e p2)
(vlax-curve-getdistatpoint e p1)
)
1e-3
)
(list p1 p2)
)
)
(defun line:point (e)
(list (vlax-curve-getstartpoint e)
(vlax-curve-getendpoint e)
)
)
(if
(and (setq e1 (entsel "\nFirst Line: "))
(setq e2 (entsel "\nSecond Line: "))
(setq el1 (entget (car e1))
el2 (entget (car e2))
)
(or
(and (equal (car e1) (car e2))
(= (cdr (assoc 0 el1)) (cdr (assoc 0 el2)) "LWPOLYLINE")
(setq i (fix (vlax-curve-getparamatpoint
(car e1)
(apply 'vlax-curve-getclosestpointto e1)
)
)
k (fix (vlax-curve-getparamatpoint
(car e2)
(apply 'vlax-curve-getclosestpointto e2)
)
)
)
(setq p (apply 'inters
(append (polyline:lineseg (car e1) i)
(polyline:lineseg (car e2) k)
)
)
)
)
(and (and (/= (car e1) (car e2))
(= (cdr (assoc 0 el1)) (cdr (assoc 0 el2)) "LINE")
)
(setq p
(apply 'inters
(append (line:point (car e1)) (line:point (car e2)))
)
)
)
)
)
(entmake (list '(0 . "circle") (cons 10 p) '(40 . 100)))
)
(princ)
)

(defun c:tt (/ polyline:lineseg line:point e1 e2 el1 el2 i k p) 
  (defun polyline:lineseg (e i / p1 p2) 
    (setq p1 (vlax-curve-getpointatparam e i) 
          p2 (vlax-curve-getpointatparam e (1+ i)) 
    ) 
    (if        (equal (distance p1 p2) 
               (- (vlax-curve-getdistatpoint e p2) 
                  (vlax-curve-getdistatpoint e p1) 
               ) 
               1e-3 
        ) 
      (list p1 p2) 
    ) 
  ) 
  (defun line:point (e) 
    (list (vlax-curve-getstartpoint e) 
          (vlax-curve-getendpoint e) 
    ) 
  ) 
  (if 
    (and (setq e1 (entsel "\nFirst Line: ")) 
         (setq e2 (entsel "\nSecond Line: ")) 
         (setq el1 (entget (car e1)) 
               el2 (entget (car e2)) 
         ) 
         (or 
           (and        (equal (car e1) (car e2)) 
                (= (cdr (assoc 0 el1)) (cdr (assoc 0 el2)) "LWPOLYLINE") 
                (setq i        (fix (vlax-curve-getparamatpoint 
                               (car e1) 
                               (apply 'vlax-curve-getclosestpointto e1) 
                             ) 
                        ) 
                      k        (fix (vlax-curve-getparamatpoint 
                               (car e2) 
                               (apply 'vlax-curve-getclosestpointto e2) 
                             ) 
                        ) 
                ) 
                (setq p        (apply 'inters 
                               (append (polyline:lineseg (car e1) i) 
                                       (polyline:lineseg (car e2) k) 
                               ) 
                        ) 
                ) 
           ) 
           (and        (and (/= (car e1) (car e2)) 
                     (= (cdr (assoc 0 el1)) (cdr (assoc 0 el2)) "LINE") 
                ) 
                (setq p 
                       (apply 'inters 
                              (append (line:point (car e1)) (line:point (car e2))) 
                       ) 
                ) 
           ) 
         ) 
    ) 
    (entmake (list '(0 . "circle") (cons 10 p) '(40 . 100))) 
  ) 
  (princ) 
)

lucas3 · 发表于 2014-9-10 09:43:57

lgx9612 发表于 2014-9-9 23:29
请指正

刘工，不错！试了多边形，能返回唯一交点座标！谢谢了！{:soso_e179:}

lucas3 · 发表于 2014-9-10 09:46:36

Free-Lancer 发表于 2014-9-10 07:36

Free-Lancer大师，多边形，矩形测试都不行，提示：“错误: 参数太少”

lucas3 · 发表于 2014-9-10 10:06:15

本帖最后由 lucas3 于 2014-9-10 14:26 编辑

lgx9612 发表于 2014-9-9 23:29
请指正

刘工，还有一个小问题，当选择的是两条直线时，或者直线与多段线，返回的是三维点的座标（含Z轴）。

Free-Lancer · 发表于 2014-9-10 11:29:56

lucas3 发表于 2014-9-10 09:46
Free-Lancer大师，多边形，矩形测试都不行，提示：“错误: 参数太少”

这个函数修改一下

(defun polyline:lineseg (e i / p1 p2)
(setq p1 (vlax-curve-getpointatparam e i)
p2 (vlax-curve-getpointatparam e (1+ i))
)
(if (equal (distance p1 p2)
(abs (- (vlax-curve-getdistatparam e i)
(vlax-curve-getdistatparam e (1+ i))
)
)
1e-3
)
(list p1 p2)
)
)

lucas3 · 发表于 2014-9-10 11:41:15

Free-Lancer 发表于 2014-9-10 11:29
这个函数修改一下

Free-Lancer大师，非常好！谢谢！

lucas3 · 发表于 2014-9-10 14:11:17

Free-Lancer 发表于 2014-9-10 11:29
这个函数修改一下

Free-Lancer大师，直线与多段线（或矩形，多边形）的交点呢？能否再补充一下？

Free-Lancer · 发表于 2014-9-10 16:18:07

lucas3 发表于 2014-9-10 14:11
Free-Lancer大师，直线与多段线（或矩形，多边形）的交点呢？能否再补充一下？

优化一下

(defun c:tt (/ polyline:lineseg line:point mGetpoints e1 e2 pl1 pl2 p)
(defun polyline:lineseg (e i / p1 p2)
(setq p1 (vlax-curve-getpointatparam e i)
p2 (vlax-curve-getpointatparam e (1+ i))
)
(if (equal (distance p1 p2)
(abs (- (vlax-curve-getdistatparam e i)
(vlax-curve-getdistatparam e (1+ i))
)
)
1e-3
)
(list p1 p2)
)
)
(defun line:point (e)
(list (vlax-curve-getstartpoint e)
(vlax-curve-getendpoint e)
)
)
(defun mGetpoints (lst / el i)
(setq el (entget (car lst)))
(cond
((= (cdr (assoc 0 el)) "LWPOLYLINE")
(setq i (fix (vlax-curve-getparamatpoint
(car lst)
(apply 'vlax-curve-getclosestpointto lst)
)
)
)
(polyline:lineseg (car lst) i)
)
((= (cdr (assoc 0 el)) "LINE")
(line:point (car lst))
)
(t nil)
)
)
(if
(and (setq e1 (entsel "\nFirst Line: "))
(setq e2 (entsel "\nSecond Line: "))
(setq pl1 (mGetpoints e1))
(setq pl2 (mGetpoints e2))
(setq p (apply 'inters (append pl1 pl2)))
)
(entmake (list '(0 . "circle") (cons 10 p) '(40 . 100)))
)
(princ)
)

(defun c:tt (/ polyline:lineseg line:point mGetpoints e1 e2 pl1 pl2 p) 
  (defun polyline:lineseg (e i / p1 p2) 
    (setq p1 (vlax-curve-getpointatparam e i) 
          p2 (vlax-curve-getpointatparam e (1+ i)) 
    ) 
    (if        (equal (distance p1 p2) 
               (abs (- (vlax-curve-getdistatparam e i) 
                       (vlax-curve-getdistatparam e (1+ i)) 
                    ) 
               ) 
               1e-3 
        ) 
      (list p1 p2) 
    ) 
  ) 
  (defun line:point (e) 
    (list (vlax-curve-getstartpoint e) 
          (vlax-curve-getendpoint e) 
    ) 
  ) 
  (defun mGetpoints (lst / el i) 
    (setq el (entget (car lst))) 
    (cond 
      ((= (cdr (assoc 0 el)) "LWPOLYLINE") 
       (setq i (fix (vlax-curve-getparamatpoint 
                      (car lst) 
                      (apply 'vlax-curve-getclosestpointto lst) 
                    ) 
               ) 
       ) 
       (polyline:lineseg (car lst) i) 
      ) 
      ((= (cdr (assoc 0 el)) "LINE") 
       (line:point (car lst)) 
      ) 
      (t nil) 
    ) 
  ) 
  (if 
    (and (setq e1 (entsel "\nFirst Line: ")) 
         (setq e2 (entsel "\nSecond Line: ")) 
         (setq pl1 (mGetpoints e1)) 
         (setq pl2 (mGetpoints e2)) 
         (setq p (apply 'inters (append pl1 pl2))) 
    ) 
     (entmake (list '(0 . "circle") (cons 10 p) '(40 . 100))) 
  ) 
  (princ) 
)

lucas3 · 发表于 2014-9-10 16:36:46

Free-Lancer 发表于 2014-9-10 16:18
优化一下

这次非常好！谢谢Free-Lancer大师！{:soso_e160:}

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

[求助] 求两线的交点

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

评分

点评

点评

点评

点评

评分

点评

点评

评分