[求助]：求弧与直线的交点？

紫云飞

请教各位高手，如何判断一段弧线与一条line线是否有交点且求出此交点的坐标。

xiao_longxin

可把弧转化为pline，再用如下程序可求出交点：

(defun GetInterPointlist (  ent_1 ent_2 /        ent1     ent2     
                        ax_ent_1 ax_ent_2 intpoints         i
                        j        k        disp  int_list
                       )
  ;(setq ent1 (entsel "\n选择第一条曲线:"))
  ;(setq ent2 (entsel "\n选择第二条曲线:"))
  ;(setq ent_1 (car ent1)
        ;ent_2 (car ent2)
  ;)
  (setq int_list nil)
  (setq ax_ent_1 (vlax-ename->vla-object ent_1)
        ax_ent_2 (vlax-ename->vla-object ent_2)
  )
  (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
  (setq intpoints (vlax-variant-value intpoints))
  (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
    (progn
      (setq i 0)
      (setq j 0)
      (setq disp "")
      (repeat
        (/ (+ 1
              (- (vlax-safearray-get-u-bound intpoints 1)
                 (vlax-safearray-get-l-bound intpoints 1)
              )
           )
           3
        )
         (setq
           disp (list
                   (vlax-safearray-get-element intpoints j)
                  
                   (vlax-safearray-get-element intpoints (+ 1 j))
                  
                   (vlax-safearray-get-element intpoints (+ 2 j))
                )
         )
         (setq i (+ 2 i)
               j (+ 3 j)
         )
         (setq int_list (append int_list (list disp)))
      )
    )
  )
  (setq int_list int_list)
)
;此是明经上mccad的程序，我只是把它改写成函数了，但
;如果两条均为spline，则反回的交点数只有一半

cyf8009

怎么全用lisp？
都不用objectarx吗

fsxm

xiao_longxin :
为什么要:"弧转化为pline啊?"
直接求不是更爽啦~
cyf8009 :
"都不用objectarx吗 "
不是没人用objectarx只是你走错地方了啦!
这里是※AutoLISP/VLISP 开发技术※ objectarx可以去对应版板的啦!

yshf

以弧线作为延伸边界，将直线延伸，对比延伸前后的直线（line）的端点是否发生改变。若发生改变，变化后的直线端点即为弧线与直线的交点。

fsxm

不用延伸的啦~可以用vlax里现成的函数的~
院长的xyp.vlx里有现成的东东~

yshf

不用Visual Lisp，用最传统的AutoLisp。

Free-Lancer

传统的 Lisp 就用数学方法求

yshf

用最传统的Auto LISP，并非一定要用数学法（即解析法）。在解决直线与各种曲线求交的问题时，可以使用CAD的CAGD法较为直观、合理，该方法的关键技术就是利用Extend命令。

Underway

;;; BY   Luis Esquivel
;;; Usage:
;;; (getlinecir-inters ＜first line point＞ ＜second line point＞ ＜arc or circle center＞ ＜radius＞)
;;; Return: List of point or nil
(defun getlinecir-inters (pl1  pl2  cen         r    /           x1        y1   x2          y2
                          h    r2   k         yt1  yt2  pt1        pt2  m          yk2
                          xt1  xt2  a         b    c           z        lst1
                         )
  (setq        x1  (car pl1)
        y1  (cadr pl1)
        x2  (car pl2)
        y2  (cadr pl2)
        r2  (expt r 2)
        h   (car cen)
        xh2 (expt (- x1 h) 2)
        k   (cadr cen)
  )
  (if (equal x2 x1 0.0001)
    (if        (>= r2 xh2)
      (setq yt1        (+ (expt (- r2 xh2) 0.5) k)
            yt2        (- k (expt (- r2 xh2) 0.5))
            pt1        (list x1 yt1)
            pt2        (list x1 yt2)
      )
    )
    (progn
      (setq m (/ (- y2 y1) (- x2 x1)))
      (if (equal m 0 0.0001)
        (if (>= r2 (setq yk2 (expt (- y1 k) 2)))
          (setq        xt1 (+ (sqrt (- r2 yk2)) h)
                xt2 (- h (sqrt (- r2 yk2)))
                pt1 (list xt1 y2)
                pt2 (list xt2 y2)
          )
        )
        (progn
          (setq        a (+ 1.0 (expt m 2))
                b (- (* 2.0 m (- x1 h (* m k))) (* 2.0 y1))
                c (+ (expt (+ (* m (- h x1)) y1) 2)
                     (* (expt m 2) (- (expt k 2) r2))
                  )
                z (- (expt b 2) (* 4 a c))
          )
          (if (equal z 0 0.0001)
            (setq z 0)
          )
          (if (>= z 0)
            (setq yt1 (/ (- (expt z 0.5) b) (* 2.0 a))
                  yt2 (/ (* -1.0 (+ (expt z 0.5) b)) (* 2.0 a))
                  xt1 (+ (/ (- yt1 y1) m) x1)
                  xt2 (+ (/ (- yt2 y1) m) x1)
                  pt1 (list xt1 yt1)
                  pt2 (list xt2 yt2)
            )
          )
        )
      )
    )
  )
  (if pt1
    (setq lst1 (append lst1 (list pt1)))
  )
  (if pt2
    (setq lst1 (append lst1 (list pt2)))
  )
  lst1
)

zml84

完全同意9楼的思想，CAGD正式lisp的精华所在，而像VBA之类自己求解，倒不如独立写个CAD了。

david96007

以前自己利用递推方法求过，不过是近似交点；

刚才又想到一个解析几何方法：建立坐标系，求得弧及线段的表达式，组成方程组，求解！

应该可以得到精确解！

zml84

;;;======================================
;;;函数名：JD
;;;功能：求一直线与其它图元的交叉点坐标。
;;;编写时间：2006-09-28
;;;======================================
(defun C:jd (/)
;;;1、提示用户选取对象
  (while
    (= (setq el (entsel "\n请点选直线对象: "))
       nil
    )
  )
  (princ "\n****请选择待求交点的对象**** ")
  (while (= (setq s1 (ssget)) nil)
    (princ "\n**未选择对象，请选择待求交点的对象** ")
  )

;;;2、记录直线起终点坐标
  (setq        ob_line        (car el) ;获取对象名
        ent        (entget ob_line)
        pt0_old        (cdr (assoc '10 ent))
        pt1_old        (cdr (assoc '11 ent))
        QD        (list ob_line pt0_old) ;生成双元表，
        ZD        (list ob_line pt1_old) ;为执行trim或extend准备响应对象
  )

;;;3、试着将直线缩短至不与任何选取的对象相交
  (setq b1 0) ;初始化标记。0表示继续；1表示结束
  (while (= b1 0)
    (command "_trim" s1 "" QD "")
    (command "_trim" s1 "" ZD "")
    (setq ent (entget ob_line)
          pt0 (cdr (assoc '10 ent))
          pt1 (cdr (assoc '11 ent))
    )

    (IF        (AND (equal PT0 PT0_OLD) (equal PT1 PT1_OLD))
      (progn ;如果起终点未变化，表示已修剪至最短，则：
        (command "_scale" ob_line "" pt0 0.9) ;对直线对象缩放，
        (command "_scale" ob_line "" pt1 0.9) ;以脱离目标对象
        (setq ent     (entget ob_line) ;重新获取其中点坐标
              pt0_old (cdr (assoc '10 ent))
              pt1_old (cdr (assoc '11 ent))
        )
        (setq b1 1)
      )
      (progn ;否则：
        (setq pt0_old pt0
              pt1_old pt1
        )
      )
    ) ;结束IF

    (setq QD (list ob_line pt0_old)
          ZD (list ob_line pt1_old)
    )
  )  ;结束while

;;;4、利用延伸命令，循环探测直线起终点是否改变
  (setq list_jd '()) ;建立空表，用于存放交点位置

     ;先延伸直线起点方向
  (setq b1 0)
  (while (= b1 0)
    (command "_extend" s1 "" QD "")
    (setq ent (entget ob_line)
          pt0 (cdr (assoc '10 ent))
    )
     ;判断直线起点是否变化
    (IF        (equal PT0 PT0_OLD)
      (setq b1 1)
      (setq list_jd (cons pt0 list_jd)
            pt0_old pt0
            QD            (list ob_line pt0_old)
      )
    ) ;结束IF
  )  ;结束while
     ;(setq list_jd ());数据表反置

     ;延伸直线终点方向
  (setq b1 0)
  (while (= b1 0)
    (command "_extend" s1 "" ZD "")
    (setq ent (entget ob_line)
          pt1 (cdr (assoc '11 ent))
    )
     ;判断直线终点是否变化
    (IF        (equal PT1 PT1_OLD)
      (setq b1 1)
      (setq list_jd (append list_jd (list pt1))
            pt1_old pt1
            ZD            (list ob_line pt1_old)
      )
    ) ;结束IF
  )  ;结束while

;;;5、结果显示输出
  (setq i 0)
  (princ "\n直线与其它所选对象的交点坐标如下:")
  (repeat (length list_jd) ;重复次数为表中成员数。
    (print (nth i list_jd)) ;打印当前成员后换行 。
    (setq i (1+ i)) ;计数器加1。
  )
  (princ "\n命令成功完成！")
  (princ)
)