求交点函数

zynyjp

写程序时经常需要用到求交点的函数，可是Autolisp中只有一个非常简单的直线求交函数INTERS。我在网也看到一些更复杂一点的成品求交函数，大都是用了VLISP的扩展函数，或者是象

XD_API这样打包好的ARX函数库。就想写一个纯lsp的通用性更强的复合求交函数。
正好今天不用上班，用了七八个小时写出来了一个可以进行圆,圆弧,线段复合求交点程序。
如果有可能的话，请大侠们出手完善一下，加上椭圆，复义线，SPLINE等，最终能够用autolisp写出可以求出两个任意类型实体的交点的复杂函数。
程序如下，请大家测试：


;______________________________________________________________________
;_圆,圆弧,线段复合求交点程序__纯LSP___BY__WKAI__晓东CAD论坛____________
;_2003.12.11.15.46_____________________________________________________
;______________________________________________________________________

;_测试用程序__在求到的交点处划出一条连到0,0的直线段____________________
(defun c:tt(/ e1 e2 pp ff)
  (princ "\n选择第一个物体:")
  (while (not e1) (setq e1 (car (entsel ))))
  (princ "\n选择第二个物体:")
  (while (not e2) (setq e2 (car (entsel ))))
  (setq ff (getint "\n第几个物体不延伸(0 都延伸,1 一号不延伸,2 二号不延伸,<3> 全部不延伸):"))
  (if (not ff) (setq ff 3))
(print (setq pp (getint_of_ents e1 e2 ff)))
  (foreach n pp
    (progn (princ "\n") (princ n) (command "line" '(0 0) n ""))
    )
  )
;_判断物体类型,选择相应函数求交点_______________________________________
(defun getint_of_ents (en_1 en_2 lim / intersections)
  (setq e1_tp (cdr (assoc 0 (entget en_1))))
  (setq e2_tp (cdr (assoc 0 (entget en_2))))
  (cond
    ((and (= "CIRCLE" e1_tp) (= "CIRCLE" e2_tp))
     (setq intersections (cic en_1 en_2 lim))
     )
    ((and (= "ARC" e1_tp) (= "ARC" e2_tp))
     (setq intersections (aia en_1 en_2 lim))
     )
    ((and (= "LINE" e1_tp) (= "LINE" e2_tp))
     (setq intersections (lil en_1 en_2 lim))
     )

    ((and (= "CIRCLE" e1_tp) (= "ARC" e2_tp))
     (setq intersections (cia en_1 en_2 lim))
     )
    ((and (= "CIRCLE" e1_tp) (= "LINE" e2_tp))
     (setq intersections (cil en_1 en_2 lim))
     )
    ((and (= "ARC" e1_tp) (= "LINE" e2_tp))
     (setq intersections (ail en_1 en_2 lim))
     )

    ((and (= "ARC" e1_tp) (= "CIRCLE" e2_tp))
     (setq intersections (cia en_2 en_1 (change_order lim)))
     )
    ((and (= "LINE" e1_tp) (= "CIRCLE" e2_tp))
     (setq intersections (cil en_2 en_1 (change_order lim)))
     )
    ((and (= "LINE" e1_tp) (= "ARC" e2_tp))
     (setq intersections (ail en_2 en_1 (change_order lim)))
     )
    (T (princ "\n请选择圆、圆弧或者线段！"))
    )
  intersections
  )
;_反转延长标志_________________________________________________________
(defun change_order(num)
  (cond
    ((= num 1)(setq num 2))
    ((= num 2)(setq num 1))
    )
  num
  )
;______________________________________________________________________
;______________________________________________________________________
;_________________求交点应用函数部分____BY__WKAI__晓东CAD论坛__________
;___________________2003.12.11.14.33___________________________________
;____limited__决定求交点时物体是否延伸_________________________________
;____0 都延伸,1 一号不延伸,2 二号不延伸,3 全部不延伸___________________

;_圆、圆交点___________________________________________________________
(defun cic (c1 c2 limited / c1_cn c2_cn c1_rd c2_rd ins)
  (setq c1_cn (cdr (assoc 10 (entget c1))))
  (setq c2_cn (cdr (assoc 10 (entget c2))))
  (setq c1_rd (cdr (assoc 40 (entget c1))))
  (setq c2_rd (cdr (assoc 40 (entget c2))))
  (setq ins (c_int_c c1_cn c1_rd c2_cn c2_rd))
  ins
  )
;_圆、圆弧交点_________________________________________________________
(defun cia (c1 c2 limited / ins ins_tmp)
  (setq c1_cn (cdr (assoc 10 (entget c1))))
  (setq c2_cn (cdr (assoc 10 (entget c2))))
  (setq c1_rd (cdr (assoc 40 (entget c1))))
  (setq c2_rd (cdr (assoc 40 (entget c2))))
  (setq c2_an1 (cdr (assoc 50 (entget c2))))
  (setq c2_an2 (cdr (assoc 51 (entget c2))))
  (setq ins (c_int_c c1_cn c1_rd c2_cn c2_rd))
  (if (or (= limited 2) (= limited 3))
    (progn
      (foreach n ins
        (if (p_on_arc n c2_cn c2_an1 c2_an2)
          (if ins_tmp
            (setq ins_tmp (append ins_tmp (list n)))
            (setq ins_tmp (list n))
            )
          )
        )
      (setq ins ins_tmp)
      )
    )
  ins
  )
;_圆弧、圆弧交点________________________________________________________
(defun aia (c1 c2 limited / ins ins_tmp)
  (setq c1_cn (cdr (assoc 10 (entget c1))))
  (setq c2_cn (cdr (assoc 10 (entget c2))))
  (setq c1_rd (cdr (assoc 40 (entget c1))))
  (setq c2_rd (cdr (assoc 40 (entget c2))))
  (setq c1_an1 (cdr (assoc 50 (entget c1))))
  (setq c1_an2 (cdr (assoc 51 (entget c1))))
  (setq c2_an1 (cdr (assoc 50 (entget c2))))
  (setq c2_an2 (cdr (assoc 51 (entget c2))))
  (setq ins (c_int_c c1_cn c1_rd c2_cn c2_rd))
  (if (or (= limited 1) (= limited 3))
    (progn
      (foreach n ins
        (if (p_on_arc n c1_cn c1_an1 c1_an2)
          (if ins_tmp
            (setq ins_tmp (append ins_tmp (list n)))
            (setq ins_tmp (list n))
            )
          )
        )
      (setq ins ins_tmp)
      )
    )
  (setq  ins_tmp nil)
  (if (or (= limited 2) (= limited 3))
    (progn
      (foreach n ins
        (if (p_on_arc n c2_cn c2_an1 c2_an2)
          (if ins_tmp
            (setq ins_tmp (append ins_tmp (list n)))
            (setq ins_tmp (list n))
            )
          )
        )
      (setq ins ins_tmp)
      )
    )
  ins
  )
;_圆、直线交点______________________________________________________
(defun cil (c l limited /  end1 end2 cen rad ins ins_tmp )
  (setq end1 (cdr (assoc 10 (entget l))))
  (setq end2 (cdr (assoc 11 (entget l))))
  (setq cen (cdr (assoc 10 (entget c))))
  (setq rad (cdr (assoc 40 (entget c))))
  (setq ins (L_INT_C end1 end2 cen rad))
  (if (or (= limited 2) (= limited 3))
    (progn
      (foreach n ins
        (if (p_on_line n end1 end2)
          (if ins_tmp
            (setq ins_tmp (append ins_tmp (list n)))
            (setq ins_tmp (list n))
            )
          )
        )
      (setq ins ins_tmp)
      )
    )
  ins
  )
;_圆弧、直线交点______________________________________________________
(defun ail (c l limited / end1 end2 cen rad ang1 ang2 ins ins_tmp)
  (setq end1 (cdr (assoc 10 (entget l))))
  (setq end2 (cdr (assoc 11 (entget l))))
  (setq cen (cdr (assoc 10 (entget c))))
  (setq rad (cdr (assoc 40 (entget c))))
  (setq ang1 (cdr (assoc 50 (entget c))))
  (setq ang2 (cdr (assoc 51 (entget c))))
  (setq ins (L_INT_C end1 end2 cen rad))
  (if (or (= limited 1) (= limited 3))
    (progn
      (foreach n ins
        (if (p_on_arc n cen ang1 ang2)
          (if ins_tmp
            (setq ins_tmp (append ins_tmp (list n)))
            (setq ins_tmp (list n))
            )
          )
        )
      (setq ins ins_tmp)
      )
    )
  (setq ins_tmp nil)
  (if (or (= limited 2) (= limited 3))
    (progn
      (foreach n ins
        (if (p_on_line n end1 end2)
          (if ins_tmp
            (setq ins_tmp (append ins_tmp (list n)))
            (setq ins_tmp (list n))
            )
          )
        )
      (setq ins ins_tmp)
      )
    )
  ins
  )
;_直线、直线交点______________________________________________________
(defun lil (l1 l2 limited / pt ins ins_tmp l1_en1 l1_en2 l2_en1 l2_en2)
  (setq l1_en1 (cdr (assoc 10 (entget l1))))
  (setq l1_en2 (cdr (assoc 11 (entget l1))))
  (setq l2_en1 (cdr (assoc 10 (entget l2))))
  (setq l2_en2 (cdr (assoc 11 (entget l2))))
  (setq ins (list (inters l1_en1 l1_en2 l2_en1 l2_en2)))
  (if (or (= limited 1) (= limited 3))
    (progn
      (foreach n ins
        (if (p_on_line n l1_en1 l1_en2)
          (if ins_tmp
            (setq ins_tmp (append ins_tmp (list n)))
            (setq ins_tmp (list n))
            )
          )
        )
      (setq ins ins_tmp)
      )
    )
  (setq ins_tmp nil)
  (if (or (= limited 1) (= limited 3))
    (progn
      (foreach n ins
        (if (p_on_line n l1_en1 l1_en2)
          (if ins_tmp
            (setq ins_tmp (append ins_tmp (list n)))
            (setq ins_tmp (list n))
            )
          )
        )
      (setq ins ins_tmp)
      )
    )
  ins
  )
;______________________________________________________________________
;______________________________________________________________________
;_________________求交点核心函数部分____BY__WKAI__晓东CAD论坛__________
;___________________2003.12.11.14.33___________________________________
;______________________________________________________________________
;_精度设置_____________________________________________________________
(setq min_num 0.0000001)
;___________________圆与圆交点函数,输入值圆心1,半径1,圆心2,半径2.返回值交点表
(defun c_int_c (c1_cen         c1_rad          c2_cen   c2_rad   /             c1
                c2         c1_end          c2_end   c1_rad   c2_rad   ints
                c1c2_dis
                )
  (setq c1c2_dis (distance c1_cen c2_cen))
  (cond
    ((equal c1c2_dis (+ c1_rad c2_rad) min_num)
     (setq ints (list (polar c1_cen (angle c1_cen c2_cen) c1_rad)))
     )
    ((equal c1c2_dis (abs (- c1_rad c2_rad)) min_num)
     (if (minusp (- c1_rad c2_rad))
       (setq ints (list (polar c2_cen (angle c2_cen c1_cen) c2_rad)))
       (setq ints (list (polar c1_cen (angle c1_cen c2_cen) c1_rad)))
       )
     )
    ((and (> c1c2_dis (abs (- c1_rad c2_rad)))
          (< c1c2_dis (+ c1_rad c2_rad))
          )
     (progn
       (princ "\nffff")
       (setq dd        (/ (- (+ (* c1c2_dis c1c2_dis) (* c1_rad c1_rad))
                      (* c2_rad c2_rad)
                      )
                   (* 2 c1c2_dis)
                   )
             )
       (setq ee (sqrt (- (* c1_rad c1_rad) (* dd dd))))
       (setq
         ints (list (polar (polar c1_cen (angle c1_cen c2_cen) dd)
                           (+ (angle c1_cen c2_cen) (/ pi 2))
                           ee
                           )
                    )
         )
       (setq ints
              (append
                ints
                (list (polar (polar c1_cen (angle c1_cen c2_cen) dd)
                             (- (angle c1_cen c2_cen) (/ pi 2))
                             ee
                             )
                      )
                )
             )

       )
     )
    )
  ints
  )
;___________________直线与圆交点函数,输入值直线端点1,端点2,圆心,半径.返回值交点表
(defun L_INT_C (l_end1 l_end2 c_cen c_rad / c l        pedal dist_cen_l int
                int1 int2 ints)
  (setq pedal (pedal_to_line c_cen l_end1 l_end2))
  (setq dist_cen_l (distance pedal c_cen))
  (cond
    ((equal c_rad dist_cen_l min_num) (setq ints (list pedal)))
    ((> c_rad dist_cen_l)
     (progn
       (setq int1
              (polar pedal
                     (angle l_end1 l_end2)
                     (sqrt (- (* c_rad c_rad) (* dist_cen_l dist_cen_l)))
                     )
             )
       (setq int2
              (polar pedal
                     (+ pi (angle l_end1 l_end2))
                     (sqrt (- (* c_rad c_rad) (* dist_cen_l dist_cen_l)))
                     )
             )
       (setq ints (list int1 int2))
       )
     )
    )
  ints
  )
;______________________________________________________________________
;______________________________________________________________________
;_________________辅助测试函数部分____BY__WKAI__晓东CAD论坛____________
;___________________2003.12.11.14.33___________________________________
;______________________________________________________________________
;___________________求点到直线的垂足的函数,输入值测试点,直线端点1,端点2.返回值垂足坐标
(defun pedal_to_line (pt pt1 pt2)
  (inters
    pt
    (polar pt (+ (/ pi 2) (angle pt1 pt2)) 1000)
    pt1
    pt2
    nil
    )
  )
;___________________测试点是否在线段上,输入值测试点,线段端点1,端点2.返回值T或者NIL
(defun p_on_line (pt pt1 pt2)
  (equal (+ (distance pt pt1) (distance pt pt2))
         (distance pt1 pt2)
         min_num
         )
  )
;___________________测试点是否在圆弧上,输入值测试点,圆心,起始角度,终止角度.返回值T或者NIL
(defun p_on_arc        (pt cn an1 an2)
  (or (and (<= (angle cn pt) an1)
           (>= (angle cn pt) an2)
           )
      (and (>= (angle cn pt) an1)
           (<= (angle cn pt) an2)
           )
      )
  )
;_________________________________________________________________________________________
;_________________________________________________________________________________________
;_________________________________________________________________________________________
;_________________________________________________________________________________________
  

cie0588

整的这么复杂啊，学习下先。

GTJ116600

确实挺复杂的，但是有确实很有用。期待着继续。

xvjiex

感谢楼主分享求交点函数！