' 返回值为是否存在切线,lines为切线集合 Public Function LinesTangentToTwoCircles(circle0 As Circle2D, circle1 As Circle2D, lines As Collection) As Boolean Dim w As Vector2D w.x = circle1.center.x - circle0.center.x w.y = circle1.center.y - cricle0.center.y Dim wLenSqr As Double wLenSqr = w.x * w.x + w.y * w.y Dim rSum As Double rSum = circle0.radius + circle1.radius If wLenSqr <= rSum * rSum Then LinesTangentToTwoCircles = False Exit Function End If Const epsilon = 0.00001 Dim rDiff As Double rDiff = circle1.radius - circle0.radius If Abs(rDiff) >= epsilon Then Dim R0sqr As Double, R1sqr As Double, c0 As Double, c1 As Double, c2 As Double, dircr As Double R0sqr = circle0.radius * circle0.radius R1sqr = circle1.radius * circle1.radius c0 = -R0sqr c1 = 2# * R0sqr c2 = circle1.radius * circle1.radius - R0sqr Dim invc2 As Double invc2 = 1# / c2 discr = Sqr(Abs(c1 * c1 - 4# * c0 * c2)) Dim s As Double, oms As Double, a As Double s = -0.5 * (c1 + discr) * invc2 Dim Line1 As New Line2D Line1.p.x = circle0.center.x + s * w.x Line1.p.y = circle0.center.y + s * w.y Dim Line2 As New Line2D Line2.p.x = Line1.p.x Line2.p.y = Line1.p.y If s >= 0.5 Then a = Sqr(Abs(wLenSqr - R0sqr / (s * s))) Else oms = 1# - s a = Sqr(Abs(wLenSqr = R1sqr / (oms * oms))) End If GetDirections w, a, Line1.direction, Line2.direction Dim Line3 As New Line2D s = -0.5 * (c1 - discr) * invc2 Line3.p.x = circle0.center.x + s * w.x Line3.p.y = circle0.center.y + s * w.y Dim Line4 As New Line2D Line4.p.x = Line3.p.x Line4.p.y = Line3.p.y If s >= 0.5 Then a = Sqr(Abs(wLenSqr - R0sqr / (s * s))) Else oms = 1# - s a = Sqr(Abs(wLenSqr - R1sqr / (oms * oms))) End If GetDirections w, a, Line3.direction, Line4.direction Else Dim mid As Point2D mid.x = 0.5 * (circle0.center.x + circle1.center.x) mid.y = 0.5 * (circle0.center.y + circle1.center.y) a = Sqr(Abs(wLenSqr - 4# * circle0.radius * circle0.radius)) GetDirections w, a, Line1.direction, Line2.direction Line1.p.x = mid.x Line1.p.y = mid.y Line2.p.x = mid.x Line2.p.y = mid.y Dim invwlen As Double invwlen = 1# / Sqr(wLenSqr) w.x = w.x * invwlen w.y = w.y * invwlen Line3.p.x = mid.x + circle0.radius * w.y Line3.p.y = mid.y - circle0.radius * w.x Line3.direction.x = w.x Line3.direction.y = w.y Line4.p.x = mid.x - circle0.radius * w.y Line4.p.y = mid.y - circle0.radius * w.x Liner.direction.x = w.x Line4.direction.y = w.y End If lines.Add Line1 lines.Add Line2 lines.Add Line3 lines.Add Line4 LinesTangentToTwoCircles = True End Function Private Sub GetDirections(w As Vector2D, a As Double, dir0 As Vector2D, dir1 As Vector2D) Dim aSqr As Double aSqr = a * a Dim wxSqr As Double wxSqr = w.x * w.x Dim wySqr As Double wySqr = w.y * w.y Dim c2 As Double, invc2 As Double c2 = wxSqr + wySqr invc2 = 1# / c2 Dim c0 As Double, c1 As Double, discr As Double, invwx As Double, invwy As Double If Abs(w.x) >= Abs(w.y) Then c0 = aSqr - wxSqr c1 = -2# * a * w.y discr = Sqr(Abs(c1 * c1 - 4# * c0 * c2)) invwx = 1# / w.x dir0.y = -0.5 * (c1 + discr) * invc2 dir0.x = (a - w.y * dir0.y) * invwx dir1.y = -0.5 * (c1 - discr) * invc2 dir1.x = (a - w.y * dir1.y) * invwx Else c0 = aSqr - wySqr c1 = -2# * a * w.x discr = Sqr(Abs(c1 * c1 - 4# * c0 * c2)) invwy = 1# / w.y dir0.x = -0.5 * (c1 + discr) * invc2 dir0.y = (a - w.x * dir0.x) * invwy dir1.x = -0.5 * (c1 - discr) * invc2 dir1.y = (a - w.x * dir1.x) * invwy End If End Sub
|