Hello,I need VBA code to draw a tangent line to two arbitrary circles in one plane. The tangent in one case does not cross the line connecting the centers of the circles, and in the other case it does.
Are you aware that you can draw such tangent lines directly using the 2-Point Line tool (with the Tangential option enabled) and tangent object snapping?
The line segment created in that way will just touch the two ellipses, but it's easy to extend the ends after creating it.
Thank You, but VBA code is needed.
This requires some mathematics. Let the circles be defined by their centers (x1, y1) and (x2, y2) and their radii r1 and r2. A line can be described by the equation
cos(θ)∙x + sin(θ)∙y + c = 0
This form has the advantage that the normal vector to the line, (cos(θ), sin(θ)), is a unit vector. For the line to be a tangent to both circles, its distance from the centers must be equal to the radii:
| cos(θ)∙x1 + sin(θ)∙y1 + c | = r1
| cos(θ)∙x2 + sin(θ)∙y2 + c | = r2
The solution to these equations depends on the sign of the expressions between the numerical value signs. For the two exterior tangents the signs must be (+,+) or (−,−), for the interior ones they must be (+,−) or (−,+).
I have written a set of subroutines which solve these equations and draws two user-defined circles, the eight tangent points and the four tangents. They only apply for the case when the circles are separated, so that there are four tangents. Here is my VBA code (I tried to apply "Source code" to the lines below only, but the whole message was selected ):
Sub LinearCosSin(pCoeff As Double, qCoeff As Double, rCoeff As Double, _ NoOfSolutions As Long, x1 As Double, x2 As Double) ' This procedure solves the trigonometric equation p·cos(x)+ q·sin(x) = r ' which can have zero, one or two solutions Dim s1 As Double, s2 As Double, r2 As Double, phi As Double, x As Double r2 = rCoeff * rCoeff s2 = pCoeff * pCoeff + qCoeff * qCoeff ' Assumed positive in all applications s1 = Sqr(s2) If r2 < s2 Then ' Two solution(s) NoOfSolutions = 2 phi = ArcTan(pCoeff / qCoeff) x = ArcCos(rCoeff / s1) x1 = phi - x x2 = phi + x ElseIf s2 = r2 Then ' One solution NoOfSolutions = 1 phi = ArcTan(pCoeff / qCoeff) x1 = phi x2 = phi Else NoOfSolutions = 0 End If End Sub Sub DrawOpenCircle(xC As Double, yC As Double, Radius As Double) ActiveLayer.CreateEllipse2 xC, yC, Radius, Radius End Sub Sub DrawFilledCircle(xC As Double, yC As Double, Radius As Double, FillColor As Color) With ActiveLayer.CreateEllipse2(xC, yC, Radius, Radius) .Outline.SetNoOutline .Fill.ApplyUniformFill FillColor End With End Sub Sub DrawExtendedLineAB( _ ByVal xA As Double, ByVal yA As Double, _ ByVal xB As Double, ByVal yB As Double, _ Optional tA As Double = 0, Optional tB As Double = 1) ' Draws a line connecting A(xA,yA) with B(xB,yB) extended at both ends ' by the parameters tA and tB; tA = -0.1 and tB = 1.1 ' would extend the line with 10 % in both directions Dim dx As Double, dy As Double dx = xB - xA: dy = yB - yA ActiveLayer.CreateLineSegment xA + tA * dx, yA + tA * dy, xA + tB * dx, yA + tB * dy End Sub Sub CircleTangents() ' Problem from community.coreldraw.com/.../some-drawing-tasks Dim NoOfSolutions As Long Dim x1 As Double, y1 As Double, r1 As Double Dim x2 As Double, y2 As Double, r2 As Double Dim Theta1 As Double, cosTheta1 As Double, sinTheta1 As Double Dim Theta2 As Double, cosTheta2 As Double, sinTheta2 As Double Dim xT1 As Double, yT1 As Double Dim xT2 As Double, yT2 As Double Dim C1 As New Color, C2 As New Color, C3 As New Color, C4 As New Color C1.RGBAssign 255, 0, 0 C2.RGBAssign 0, 255, 0 C3.RGBAssign 0, 0, 255 C4.RGBAssign 0, 255, 255 ActiveDocument.Unit = cdrMillimeter x1 = 70: y1 = 70: r1 = 50 x2 = 130: y2 = 130: r2 = 20 DrawOpenCircle x1, y1, r1 DrawOpenCircle x2, y2, r2 LinearCosSin x1 - x2, y1 - y2, r2 - r1, NoOfSolutions, Theta1, Theta2 cosTheta1 = Cos(Theta1): sinTheta1 = Sin(Theta1) cosTheta2 = Cos(Theta2): sinTheta2 = Sin(Theta2) xT1 = x1 + cosTheta1 * r1 yT1 = y1 + sinTheta1 * r1 DrawFilledCircle xT1, yT1, 1, C1 xT2 = x2 + cosTheta1 * r2 yT2 = y2 + sinTheta1 * r2 DrawFilledCircle xT2, yT2, 1, C1 DrawExtendedLineAB xT1, yT1, xT2, yT2, -0.2, 1.2 xT1 = x1 + cosTheta2 * r1 yT1 = y1 + sinTheta2 * r1 DrawFilledCircle xT1, yT1, 1, C2 xT2 = x2 + cosTheta2 * r2 yT2 = y2 + sinTheta2 * r2 DrawFilledCircle xT2, yT2, 1, C2 DrawExtendedLineAB xT1, yT1, xT2, yT2, -0.2, 1.2 LinearCosSin x1 - x2, y1 - y2, -r2 - r1, NoOfSolutions, Theta1, Theta2 cosTheta1 = Cos(Theta1): sinTheta1 = Sin(Theta1) cosTheta2 = Cos(Theta2): sinTheta2 = Sin(Theta2) xT1 = x1 + cosTheta1 * r1 yT1 = y1 + sinTheta1 * r1 DrawFilledCircle xT1, yT1, 1, C3 xT2 = x2 - cosTheta1 * r2 yT2 = y2 - sinTheta1 * r2 DrawFilledCircle xT2, yT2, 1, C3 DrawExtendedLineAB xT1, yT1, xT2, yT2, -0.2, 1.2 xT1 = x1 + cosTheta2 * r1 yT1 = y1 + sinTheta2 * r1 DrawFilledCircle xT1, yT1, 1, C4 xT2 = x2 - cosTheta2 * r2 yT2 = y2 - sinTheta2 * r2 DrawFilledCircle xT2, yT2, 1, C4 DrawExtendedLineAB xT1, yT1, xT2, yT2, -0.2, 1.2 End Sub
I forgot to include a screen shot of the solution drawing:
Hello,Thank You for this answer!Please note, that circles are with random distance one from other and random diameter. The two circles exist and sub must draw only tangents. Circles are not inscribed or overlapped.Please remove DrawOpenCircle code and give solution to draw tangents between 2 existing ellipses.Greetings!