Sub kouten_Sen(xs, ys, xe, ye, Cx, Cy, R, Ip_x1, Ip_y1, Ip_x2, Ip_y2)
'=====================
'2点(xs,ys)、(xe,ye)を通る直線 Aと 中心(Cx,Cy)で半径Rの円Bとの交点
'(Ip_x1,Ip_y1) と(Ip_x2,Ip_y2)の2点を求めます。
'=====================
Dim A As Single, b As Single, c As Single, k As Single
Dim l As Single
Dim ex As Single, ey As Single
Dim vx As Single, vy As Single
Dim xp As Single, xy As Single
Gx = Cx
Gy = Cy - R
A = ye - ys
b = xs - xe
c = -(A * xs + b * ys)
l = Sqr((xe - xs) ^ 2 + (ye - ys) ^ 2)
ex = (xe - xs) / l
ey = (ye - ys) / l
vx = -ey
vy = ex
k = -(A * Cx + b * Cy + c) / (A * vx + b * vy)
xp = Cx + k * vx
yp = Cy + k * vy
s = Sqr(R ^ 2 - k ^ 2)
If s < 0 Then
End
Else
Ip_x1 = xp + s * ex
Ip_y1 = yp + s * ey
Ip_x2 = xp - s * ex
Ip_y2 = yp - s * ey
End If
'===================================
'===== グラフ上に交点 をプロットします。
ActiveSheet.Shapes.AddShape(msoShapeOval, Ip_x1, Ip_y1, Dot, Dot).Select
ActiveSheet.Shapes.AddShape(msoShapeOval, Ip_x2, Ip_y2, Dot, Dot).Select
End Sub