Тема: Касательная к двум окружностям

Добрый день !
Курил форум, но ничего по этой теме нет.
Создаю две окружности AddCircle (Cyr1, Cyr2)
Не у кого нет ли алгоритма как автоматически построить касательные к этим двум окружностям (их может быть аж 4) ?
Ну или вообще у кого-нибудь есть достижения в автоматическом поиске касательной для двух окружностей ?

Re: Касательная к двум окружностям

А как найти точку касания окружности прямой выходящей из известной точки ?

Re: Касательная к двум окружностям

> Alexander Larionov
Насчет 4-х касательных я пас,
попробуй для начала две:

Option Explicit
' by Fatty T.O.H () 2007 * all rights removed
Sub DrawTangents()
Dim oEnt As AcadEntity
Dim oCirc1 As AcadCircle, oCirc2 As AcadCircle
Dim oLine1 As AcadLine, oLine2 As AcadLine
Dim varPt As Variant
Dim Rad1 As Double, Rad2 As Double
Dim dblRad1 As Double, dblRad2 As Double
Dim dblAng1 As Double, dblAng2 As Double
Dim centPt1 As Variant, centPt2 As Variant
Dim tangPt1() As Double, tangPt2() As Double
Dim pi As Double
pi = Atn(1#) * 4
MsgBox "Need to check on geometrical accuracy"
ThisDrawing.Utility.GetEntity oEnt, varPt, vbCrLf & "Select the first circle"
If TypeOf oEnt Is AcadCircle Then
Set oCirc1 = oEnt
End If
ThisDrawing.Utility.GetEntity oEnt, varPt, vbCrLf & "Select the second circle"
If TypeOf oEnt Is AcadCircle Then
Set oCirc2 = oEnt
End If
centPt1 = oCirc1.Center
centPt2 = oCirc2.Center
dblAng1 = ThisDrawing.Utility.AngleFromXAxis(centPt1, centPt2)
Rad1 = oCirc1.Radius
Rad2 = oCirc2.Radius
If Rad1 > Rad2 Then
dblRad1 = Rad1
dblRad2 = Rad2
ElseIf Rad1 < Rad2 Then
dblAng1 = dblAng1 - pi
dblRad1 = Rad2
dblRad2 = Rad1
End If
If Rad1 <> Rad2 Then
dblAng2 = Atn((Sqr(Get_Distance(centPt1, centPt2) ^ 2 - (dblRad1 - dblRad2) ^ 2)) / (dblRad1 - dblRad2))
dblAng1 = dblAng1 + dblAng2
Else
dblAng1 = dblAng1 + pi / 2
End If
With ThisDrawing.Utility
tangPt1 = .PolarPoint(centPt1, dblAng1, Rad1)
tangPt2 = .PolarPoint(centPt2, dblAng1, Rad2)
End With
ThisDrawing.ModelSpace.AddLine centPt1, centPt2
Set oLine1 = ThisDrawing.ModelSpace.AddLine(tangPt1, tangPt2)
oLine1.Mirror centPt1, centPt2
Set oLine2 = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
oLine1.color = acRed
oLine2.color = acRed
End Sub
Public Function Get_Distance(fPoint As Variant, sPoint As Variant) As Double
' by Frank Oquendo
     Dim x1 As Double, x2 As Double
     Dim y1 As Double, y2 As Double
     Dim z1 As Double, z2 As Double
     Dim cDist As Double
     x1 = fPoint(0): y1 = fPoint(1): z1 = fPoint(2)
     x2 = sPoint(0): y2 = sPoint(1): z2 = sPoint(2)
     cDist = Sqr(((x2 - x1) ^ 2) + ((y2 - y1) ^ 2) + ((z2 - z1) ^ 2))
     Get_Distance = cDist
End Function

~'J'~

Re: Касательная к двум окружностям

Cтроится две из четырех касательных, но то что надо пока нет. Пересекающиеся касательные не строятся.
Fatty спасибо за участие в решении проблемы

Re: Касательная к двум окружностям

> Alexander Larionov
Добавка:

Set oLine3 = ThisDrawing.ModelSpace.AddLine(centPt1, tangPt2)
Set oLine4 = ThisDrawing.ModelSpace.AddLine(centPt2, tangPt1)

~'J'~

Re: Касательная к двум окружностям

> Fatty
Это уже не будут касательные, линии будут пересекать окружности в двух точках.

Re: Касательная к двум окружностям

> Alexander Larionov
А, понял
Без гарантии
~'J'~

Re: Касательная к двум окружностям

> Alexander Larionov
Забыл про этот топик...
Вот решение

Option Explicit
Sub DrawTangent()
Dim oEnt As AcadEntity
Dim oCirc1 As AcadCircle, oCirc2 As AcadCircle
Dim oLine1 As AcadLine, oLine2 As AcadLine
Dim varPt As Variant
Dim Rad1 As Double, Rad2 As Double
Dim dblRad1 As Double, dblRad2 As Double
Dim dblAng1 As Double, dblAng2 As Double, dirAng As Double
Dim centPt1 As Variant, centPt2 As Variant
Dim tangPt1() As Double, tangPt2() As Double
Dim pi As Double, dblDis As Double
pi = Atn(1#) * 4
ThisDrawing.Utility.GetEntity oEnt, varPt, vbCrLf & "Select the first circle"
If TypeOf oEnt Is AcadCircle Then
Set oCirc1 = oEnt
End If
ThisDrawing.Utility.GetEntity oEnt, varPt, vbCrLf & "Select the second circle"
If TypeOf oEnt Is AcadCircle Then
Set oCirc2 = oEnt
End If
centPt1 = oCirc1.Center
centPt2 = oCirc2.Center
dblAng1 = ThisDrawing.Utility.AngleFromXAxis(centPt1, centPt2)
dirAng = dblAng1
Rad1 = oCirc1.Radius
Rad2 = oCirc2.Radius
dblDis = Get_Distance(centPt1, centPt2)
If Rad1 > Rad2 Then
dblRad1 = Rad1
dblRad2 = Rad2
ElseIf Rad1 < Rad2 Then
dblAng1 = dblAng1 - pi
dblRad1 = Rad2
dblRad2 = Rad1
End If
If Rad1 <> Rad2 Then
dblAng2 = Atn((Sqr(dblDis ^ 2 - (dblRad1 - dblRad2) ^ 2)) / (dblRad1 - dblRad2))
dblAng1 = dblAng1 + dblAng2
Else
dblAng1 = dblAng1 + pi / 2
End If
With ThisDrawing.Utility
tangPt1 = .PolarPoint(centPt1, dblAng1, Rad1)
tangPt2 = .PolarPoint(centPt2, dblAng1, Rad2)
End With
ThisDrawing.ModelSpace.AddLine centPt1, centPt2
Set oLine1 = ThisDrawing.ModelSpace.AddLine(tangPt1, tangPt2)
oLine1.Mirror centPt1, centPt2
Set oLine2 = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
oLine1.color = acRed
oLine2.color = acRed
Dim fstDis As Double, sndDis As Double
Dim Kat1 As Double, dblAng As Double, dblAngA As Double
fstDis = dblDis * Rad1 / (Rad2 + Rad1)
Kat1 = Sqr(Abs(fstDis ^ 2 - Rad1 ^ 2))
dblAngA = Atn(Kat1 / Rad1)
dblAng = dirAng + dblAngA
With ThisDrawing.Utility
tangPt1 = .PolarPoint(centPt1, dblAng, Rad1)
tangPt2 = .PolarPoint(centPt2, dirAng + pi + dblAngA, Rad2)
End With
Set oLine1 = ThisDrawing.ModelSpace.AddLine(tangPt1, tangPt2)
oLine1.Mirror centPt1, centPt2
Set oLine2 = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
oLine1.color = acMagenta
oLine2.color = acMagenta
End Sub
Public Function Get_Distance(fPoint As Variant, sPoint As Variant) As Double
     Dim x1 As Double, x2 As Double
     Dim y1 As Double, y2 As Double
     Dim z1 As Double, z2 As Double
     Dim cDist As Double
     x1 = fPoint(0): y1 = fPoint(1): z1 = fPoint(2)
     x2 = sPoint(0): y2 = sPoint(1): z2 = sPoint(2)
     cDist = Sqr(((x2 - x1) ^ 2) + ((y2 - y1) ^ 2) + ((z2 - z1) ^ 2))
     Get_Distance = cDist
End Function

~'J'~

Re: Касательная к двум окружностям

Спасибо большое - круто !

Re: Касательная к двум окружностям

> Alexander Larionov
Рад помочь, только это вовсе не круто,
а довольно сыро, попробуй оптимизировать код
самомтоятельно
~'J'~