[试用]：求三条直线的所有切圆（包括内切圆），原码

xiao_longxin

求三条直线的所有切圆（包括内切圆），原码
欢迎测试，以待改进

sany

不错啊，对于任何位置关系的三条直线都能用，而且是通用函数。可贵的是用几何方法编的程序，算法对于vba同样适用。

xiao_longxin

我把源码帖在下面，方便不能下载的朋友：

[PHP]
;;By Xiao_longxin
;;e1_star  e1_end 第一条直线起、点
;;e2_star  e2_end 第二条直线起、点
;;e3_star  e3_end 第三条直线起、终点

;;返回：
;;（t or nil ((圆心坐标) 半径)　((圆心坐标) 半径).........）
;;当返回值第一元素为t时，表示有内切圆（即第一个）
;;当返回值第一元素为nil时，时表示无内圆
;;当返回值为nil时，表示三线平行，没有切圆

(defun qieyuan (e1_star         e1_end          e2_star  e2_end   e3_star  e3_end
                /         ent          e1_star  e1_end   e2_star  e2_end
                e3_star         e3_end          ang1           ang2            ang3     j1_2
                j1_3         j2_3          e1_e2           e1_e3    e2_e3    cr_pt
                jd1         jd2          jd3           j1_3_    j2_3_    cr_r
                cr_list
               )
  ;;(setq e1_star (getpoint))
  ;;(setq e1_end (getpoint))
  ;;(setq e2_star (getpoint))
  ;;(setq e2_end (getpoint))
  ;;(setq e3_star (getpoint))
  ;;(setq e3_end (getpoint))
  ;;(command ".-color" 7)
  ;;(command "point" e1_star)
  ;;(command "point" e1_end)
  ;;(command "point" e2_star)
  ;;(command "point" e2_end)
  ;;(command "point" e3_star)
  ;;(command "point" e3_end)
                                        ;求得三条线的交点
  (setq j1_2 (inters e1_star e1_end e2_star e2_end nil))
  (setq j1_3 (inters e1_star e1_end e3_star e3_end nil))
  (setq j2_3 (inters e2_star e2_end e3_star e3_end nil))
  ;;(command ".-color" 1)
  ;;(command "pline" j1_2 j1_3 "")
  ;;(command "pline" j1_2 j2_3 "")
  ;;(command "pline" j2_3 j1_3 "")
                                        ;得到三条直线的方位角
  (setq ang1 (angle e1_star e1_end))
  (setq ang2 (angle e2_star e2_end))
  (setq ang3 (angle e3_star e3_end))
                                        ;分别判断三条直线之间是否平行
  (if (or (< (abs (- ang1 ang2)) 0.000005)
          (and (< (abs (- ang1 ang2)) (+ pi 0.000005))
               (> (abs (- ang1 ang2)) (- pi 0.000005))
          )
      )
    (setq e1_e2 t)
  )
  (if (or (< (abs (- ang1 ang3)) 0.000005)
          (and (< (abs (- ang1 ang3)) (+ pi 0.000005))
               (> (abs (- ang1 ang3)) (- pi 0.000005))
          )
      )
    (setq e1_e3 t)
  )
  (if (or (< (abs (- ang3 ang2)) 0.000005)
          (and (< (abs (- ang3 ang2)) (+ pi 0.000005))
               (> (abs (- ang3 ang2)) (- pi 0.000005))
          )
      )
    (setq e2_e3 t)
  )

  (if (and e1_e2 e2_e3 e1_e3)
    (progn ;;如果三条直线平行则跳中止程序
           (prompt "三线平行，没有切圆！")
           (setq cr_list nil)
    )
    (progn
      (if (and (not e1_e2) (not e1_e3) (not e2_e3))
                                        ;如果三条直线都不平行则
        (progn
          (setq cr_list '(t))
          ;;求内切圆
          (setq
            jd1        (rem (/ (+ ang1 (* 2 pi) ang3 (* 2 pi)) 2) (* 2 pi))
          )
          (setq j1_3_ (polar j1_3 jd1 100))
          ;;(command "pline" j1_3 j1_3_ "")
          (setq
            jd2        (rem (/ (+ ang2 (* 2 pi) ang3 (* 2 pi)) 2) (* 2 pi))
          )
          (setq j2_3_ (polar j2_3 jd2 100))
          ;;(command "pline" j2_3 j2_3_ "")
          (setq cr_pt (inters j1_3 j1_3_ j2_3 j2_3_ nil))
          (setq jd3 (polar cr_pt (+ ang1 (/ pi 2)) 100))
          (setq cr_r (inters j1_3 j1_2 jd3 cr_pt nil))
          ;;(command "._circle" cr_pt cr_r)
          (setq
            cr_list (append cr_list
                            (list (list cr_pt (distance cr_pt cr_r)))
                    )
          )
          ;;求出其它的切圆
          　　　　　　　　　　　
          ;;第一个
          (setq
            jd1
             (rem (/ (+ ang1 (* 2 pi) ang3 (* 3 pi)) 2) (* 2 pi))
          )
          (setq j1_3_ (polar j1_3 jd1 100))
          (setq
            jd2
             (rem (/ (+ ang2 (* 3 pi) ang1 (* 3 pi)) 2) (* 2 pi))
          )
          (setq j2_3_ (polar j1_2 jd2 100))
          (setq cr_pt (inters j1_3 j1_3_ j1_2 j2_3_ nil))
          (setq jd3 (polar cr_pt (+ ang1 (/ pi 2)) 100))
          (setq cr_r (inters j1_3 j1_2 jd3 cr_pt nil))
          ;;(command "._circle" cr_pt cr_r)
          (setq        cr_list
                 (append cr_list
                         (list (list cr_pt (distance cr_pt cr_r)))
                 )
          )
          ;;第二个
          (setq
            jd1
             (rem (/ (+ ang1 (* 3 pi) ang3 (* 2 pi)) 2) (* 2 pi))
          )
          (setq j1_3_ (polar j1_3 jd1 100))
          (setq
            jd2
             (rem (/ (+ ang2 (* 2 pi) ang3 (* 3 pi)) 2) (* 2 pi))
          )
          (setq j2_3_ (polar j2_3 jd2 100))
          (setq cr_pt (inters j1_3 j1_3_ j2_3 j2_3_ nil))
          (setq jd3 (polar cr_pt (+ ang3 (/ pi 2)) 100))
          (setq cr_r (inters j1_3 j2_3 jd3 cr_pt nil))
          ;;(command "._circle" cr_pt cr_r)
          (setq        cr_list
                 (append cr_list
                         (list (list cr_pt (distance cr_pt cr_r)))
                 )
          )
          ;;第三个
          (setq
            jd1
             (rem (/ (+ ang1 (* 2 pi) ang2 (* 2 pi)) 2) (* 2 pi))
          )
          (setq j1_3_ (polar j1_2 jd1 100))
          (setq
            jd2
             (rem (/ (+ ang2 (* 3 pi) ang3 (* 2 pi)) 2) (* 2 pi))
          )
          (setq j2_3_ (polar j2_3 jd2 100))
          (setq cr_pt (inters j1_2 j1_3_ j2_3 j2_3_ nil))
          (setq jd3 (polar cr_pt (+ ang2 (/ pi 2)) 100))
          (setq cr_r (inters j2_3 j1_2 jd3 cr_pt nil))
          ;;(command "._circle" cr_pt cr_r)
          (setq        cr_list
                 (append cr_list
                         (list (list cr_pt (distance cr_pt cr_r)))
                 )
          )
          ;;end 其它切圆
        )
                                        ;end 三条行都不平行

        (progn                                ;有两条线平行
          (setq cr_list '(nil))
          (cond        (e1_e2
                 (if (< (abs (- ang1 ang2)) 0.000005)
                   (setq ang1 (+ ang1 pi))
                 )
                 (setq
                   jd1
                    (rem (/ (+ ang1 (* 2 pi) ang3 (* 2 pi)) 2) (* 2 pi))
                 )
                 (setq j1_3_ (polar j1_3 jd1 100))
                 (setq
                   jd2
                    (rem (/ (+ ang2 (* 2 pi) ang3 (* 2 pi)) 2) (* 2 pi))
                 )
                 (setq j2_3_ (polar j2_3 jd2 100))
                 (setq cr_pt (inters j1_3 j1_3_ j2_3 j2_3_ nil))
                 (setq jd3 (polar cr_pt (+ ang3 (/ pi 2)) 100))
                 (setq cr_r (inters j1_3 j2_3 jd3 cr_pt nil))
                 ;;(command "._circle" cr_pt cr_r)
                 (setq cr_list
                        (append        cr_list
                                (list (list cr_pt (distance cr_pt cr_r)))
                        )
                 )
                                        ;求得与之相补的切圆
                 (setq
                   jd1
                    (rem (/ (+ ang1 (* 3 pi) ang3 (* 2 pi)) 2) (* 2 pi))
                 )
                 (setq j1_3_ (polar j1_3 jd1 100))
                 (setq
                   jd2
                    (rem (/ (+ ang2 (* 2 pi) ang3 (* 3 pi)) 2) (* 2 pi))
                 )
                 (setq j2_3_ (polar j2_3 jd2 100))
                 (setq cr_pt (inters j1_3 j1_3_ j2_3 j2_3_ nil))
                 (setq jd3 (polar cr_pt (+ ang3 (/ pi 2)) 100))
                 (setq cr_r (inters j1_3 j2_3 jd3 cr_pt nil))
                 ;;(command "._circle" cr_pt cr_r)
                 (setq cr_list
                        (append        cr_list
                                (list (list cr_pt (distance cr_pt cr_r)))
                        )
                 )
                )                        ;end e1_e2
                (e1_e3
                 (if (< (abs (- ang1 ang3)) 0.000005)
                   (setq ang1 (+ ang1 pi))
                 )
                 (setq
                   jd1
                    (rem (/ (+ ang1 (* 2 pi) ang2 (* 2 pi)) 2) (* 2 pi))
                 )
                 (setq j1_3_ (polar j1_2 jd1 100))
                 (setq
                   jd2
                    (rem (/ (+ ang2 (* 2 pi) ang3 (* 2 pi)) 2) (* 2 pi))
                 )
                 (setq j2_3_ (polar j2_3 jd2 100))
                 (setq cr_pt (inters j1_2 j1_3_ j2_3 j2_3_ nil))
                 (setq jd3 (polar cr_pt (+ ang2 (/ pi 2)) 100))
                 (setq cr_r (inters j1_2 j2_3 jd3 cr_pt nil))
                 ;;(command "._circle" cr_pt cr_r)
                 (setq cr_list
                        (append        cr_list
                                (list (list cr_pt (distance cr_pt cr_r)))
                        )
                 )
                                        ;求得互补切圆
                 (setq
                   jd1
                    (rem (/ (+ ang1 (* 3 pi) ang2 (* 2 pi)) 2) (* 2 pi))
                 )
                 (setq j1_3_ (polar j1_2 jd1 100))
                 (setq
                   jd2
                    (rem (/ (+ ang2 (* 3 pi) ang3 (* 2 pi)) 2) (* 2 pi))
                 )
                 (setq j2_3_ (polar j2_3 jd2 100))
                 (setq cr_pt (inters j1_2 j1_3_ j2_3 j2_3_ nil))
                 (setq jd3 (polar cr_pt (+ ang2 (/ pi 2)) 100))
                 (setq cr_r (inters j1_2 j2_3 jd3 cr_pt nil))
                 ;;(command "._circle" cr_pt cr_r)
                 (setq cr_list
                        (append        cr_list
                                (list (list cr_pt (distance cr_pt cr_r)))
                        )
                 )
                )                        ;end e1_e3
                (e2_e3
                 (if (< (abs (- ang2 ang3)) 0.000005)
                   (setq ang2 (+ ang2 pi))
                 )
                 (setq
                   jd1
                    (rem (/ (+ ang1 (* 3 pi) ang2 (* 2 pi)) 2) (* 2 pi))
                 )
                 (setq j1_3_ (polar j1_2 jd1 100))
                 (setq
                   jd2
                    (rem (/ (+ ang1 (* 3 pi) ang3 (* 2 pi)) 2) (* 2 pi))
                 )
                 (setq j2_3_ (polar j1_3 jd2 100))
                 (setq cr_pt (inters j1_2 j1_3_ j1_3 j2_3_ nil))
                 (setq jd3 (polar cr_pt (+ ang1 (/ pi 2)) 100))
                 (setq cr_r (inters j1_2 j1_3 jd3 cr_pt nil))
                 ;;(command "._circle" cr_pt cr_r)
                 (setq cr_list
                        (append        cr_list
                                (list (list cr_pt (distance cr_pt cr_r)))
                        )
                 )
                                        ;求得互补切圆
                 (if (< (abs (- ang2 ang3)) 0.000005)
                   (setq ang2 (+ ang2 pi))
                 )
                 (setq
                   jd1
                    (rem (/ (+ ang1 (* 2 pi) ang2 (* 2 pi)) 2) (* 2 pi))
                 )
                 (setq j1_3_ (polar j1_2 jd1 100))
                 (setq
                   jd2
                    (rem (/ (+ ang1 (* 2 pi) ang3 (* 2 pi)) 2) (* 2 pi))
                 )
                 (setq j2_3_ (polar j1_3 jd2 100))
                 (setq cr_pt (inters j1_2 j1_3_ j1_3 j2_3_ nil))
                 (setq jd3 (polar cr_pt (+ ang1 (/ pi 2)) 100))
                 (setq cr_r (inters j1_2 j1_3 jd3 cr_pt nil))
                 ;;(command "._circle" cr_pt cr_r)
                 (setq cr_list
                        (append        cr_list
                                (list (list cr_pt (distance cr_pt cr_r)))
                        )
                 )
                )
          )
        )                                ;end 有两条线平行
      )
    )
  )
)

ysx810210

谢谢楼主源码共享，看了再说