TRIANGLE IN ELLIPSE, ELLIPSE ARROUND TRIANGLE

Funny, I've been working on this too. I like the macro you've provided. It's off a bit but probably due to infinite decimal amount. I was actually trying to go the other way around though.

EllipseToTriangle - given an equilateral triangle.

Zooming in after using the macro I get this. Using the Smart Fill Tool won't get the expected outcome.

I love this game!

I hope it's not news to you that all measurements, including Corel's, have some precision. I checked for a circle with a diameter of 30000 mm.

1. Corel did not draw me a circle with a diameter of 30000 mm!
WTF! I always got a circle with a diameter of 30000.001!
But I did not enter that third unit after the comma.
So can you trust Corel after this?
I ask skeptics to calm down! 29999.999 does not give 30000#
Check please!

2. The displacement of the apex of the triangle inscribed by this macro was 2.813 mm along X and 4.851 mm along Y
This is 0.0093766(6) and 0.01617 percent (respectively) or about 0.00012773(3). That's the fourth digit after the decimal point, guys.
So we got the accuracy that Corel gives ~0.000128
Very good, up to me.

Before run this code
1. Draw triangle and select it
2. Run code
3. See result as above - ellipse around triangle  

Public mdelta as double

Sub Ellipse_ar_tri()
'On Error GoTo errorh
'Me.Hide
miro1
Dim mcurve As Curve
Dim msp As SubPath
Dim mactiveshape As Shape
Dim cps As CrossPoints, cp As CrossPoint
Dim firstnode_x As Double
Dim firstnode_y As Double
Dim secnode_x As Double
Dim secnode_y As Double
Dim tirdnode_x As Double
Dim tirdnode_y As Double

'Public S1, S2, S3 As Shape

Set mactiveshape = ActiveShape

'WORK MsgBox mactiveshape.Curve.Nodes.Count & " NODES"
'WORK MsgBox mactiveshape.Curve.Segments.Count & " SEGMENTS"

firstnode_x = mactiveshape.Curve.Nodes(1).PositionX
firstnode_y = mactiveshape.Curve.Nodes(1).PositionY
Set mcurve = Application.CreateCurve(ActiveDocument)
Set msp = mcurve.CreateSubPath(firstnode_x, firstnode_y)
msp.AppendLineSegment mactiveshape.Curve.Nodes(2).PositionX, mactiveshape.Curve.Nodes(2).PositionY
Set S1 = ActiveLayer.CreateCurve(mcurve)
'MsgBox S1.Segments(1).Length
S1.RotationAngle = 90
extend_line
S1.Curve.ReverseDirection
extend_line
'MsgBox S1.Curve.Length
'S1.Stretch 4
'S1.SetSizeEx S1.CenterX, S1.CenterY, 5, 5
'S1.CenterX = mactiveshape.Curve.Segments(1).

secnode_x = mactiveshape.Curve.Nodes(2).PositionX
secnode_y = mactiveshape.Curve.Nodes(2).PositionY
Set mcurve1 = Application.CreateCurve(ActiveDocument)
Set msp1 = mcurve1.CreateSubPath(secnode_x, secnode_y)
msp1.AppendLineSegment mactiveshape.Curve.Nodes(3).PositionX, mactiveshape.Curve.Nodes(3).PositionY
Set S2 = ActiveLayer.CreateCurve(mcurve1)
'MsgBox S1.Segments(1).Length
S2.RotationAngle = 90
extend_line
S2.Curve.ReverseDirection
extend_line
tirdnode_x = mactiveshape.Curve.Nodes(3).PositionX
tirdnode_y = mactiveshape.Curve.Nodes(3).PositionY
Set mcurve2 = Application.CreateCurve(ActiveDocument)
Set msp2 = mcurve2.CreateSubPath(tirdnode_x, tirdnode_y)
msp2.AppendLineSegment mactiveshape.Curve.Nodes(1).PositionX, mactiveshape.Curve.Nodes(1).PositionY
Set S3 = ActiveLayer.CreateCurve(mcurve2)
'MsgBox S1.Segments(1).Length
S3.RotationAngle = 90
extend_line
S3.Curve.ReverseDirection
extend_line

'S1.Delete
'Set cps = S2.GetIntersections(S3)
'S2.DisplayCurve.GET
'MsgBox "X = " & cps.Item(1).PositionX & " Y = " & cps.Item(1).PositionY

If S1.DisplayCurve.IntersectsWith(S2.DisplayCurve) Then
'MsgBox "TWO CURVES INTERSECT"
S3.Selected = False
S1.Selected = True
S2.Selected = True
GoTo CREATE_ELLIPSE
'Else
'MsgBox "NO INTRSECT POINT"
Exit Sub
End If

If S1.DisplayCurve.IntersectsWith(S3.DisplayCurve) Then
'MsgBox "TWO CURVES INTERSECT"
S3.Selected = True
S1.Selected = True
S2.Selected = False
GoTo CREATE_ELLIPSE
'Else
'MsgBox "NO INTRSECT POINT"
Exit Sub
End If

If S2.DisplayCurve.IntersectsWith(S3.DisplayCurve) Then
'MsgBox "TWO CURVES INTERSECT"
S3.Selected = True
S1.Selected = False
S2.Selected = True
GoTo CREATE_ELLIPSE
'Else
'MsgBox "NO INTRSECT POINT"
Exit Sub
End If

'Exit Sub

CREATE_ELLIPSE:
'S2.Selected = True
'S3.Selected = True

Dim sr As ShapeRange
Dim SP1 As SubPath, SP2 As SubPath
'Dim cps As CrossPoints, cp As CrossPoint
Dim X As Double, Y As Double, n As Long
' Public mellipse As Shape
Dim S1GUIDE As Shape
Dim S2GUIDE As Shape
'Exit Sub
Set sr = ActiveSelectionRange

If sr.Count <> 2 Then
MsgBox "Please select two curves" & vbCr & "mdelta current value = " & mdelta & vbCr & "Increase mdelta value in Sub extend_line()", vbCritical
Exit Sub
End If
If sr(1).Type <> cdrCurveShape Or sr(2).Type <> cdrCurveShape Then
MsgBox "One of the selected shapes is not a curve", vbCritical
Exit Sub
End If
n = 0

'MRADIUS = 1
For Each SP1 In sr(1).Curve.SubPaths
For Each SP2 In sr(2).Curve.SubPaths
Set cps = SP1.GetIntersections(SP2)
XELLIPSE = cps.Item(1).PositionX
YELLIPSE = cps.Item(1).PositionY
'po-goljama elipsa MRADIUS = Sqr((XELLIPSE - ActiveShape.Curve.Nodes(1).PositionX) ^ 2 + (ActiveShape.Curve.Nodes(1).PositionY - YELLIPSE) ^ 2)
' po-malka elipsa MRADIUS = Sqr((XELLIPSE - ActiveShape.Curve.Nodes(2).PositionX) ^ 2 + (ActiveShape.Curve.Nodes(2).PositionY - YELLIPSE) ^ 2)
'greshka MRADIUS = Sqr((XELLIPSE - ActiveShape.Curve.Nodes(3).PositionX) ^ 2 + (ActiveShape.Curve.Nodes(3).PositionY - YELLIPSE) ^ 2)
MRADIUS = Sqr((XELLIPSE - firstnode_x) ^ 2 + (firstnode_y - YELLIPSE) ^ 2)
Set mellipse = ActiveLayer.CreateEllipse2(cps.Item(1).PositionX, cps.Item(1).PositionY, MRADIUS)

' For Each cp In cps
' Set mellipse = ActiveLayer.CreateEllipse2(cp.PositionX, cp.PositionY, MRADIUS)
' mellipse.Fill.UniformColor.RGBAssign 255, 0, 0
' mx = cp.PositionX ' * 25.4 'mm
' my = cp.PositionY ' * 25.4 'mm
' Next cp

n = n + cps.Count
Next SP2
Next SP1
'MsgBox n & " intersection point(s) found" & Chr(13) & "X = " & mx * 25.4 & Chr(13) & "Y = " & my * 25.4
Set S1GUIDE = ActiveDocument.MasterPage.GuidesLayer.CreateGuideAngle(mx, my, 0#)
Set S2GUIDE = ActiveDocument.MasterPage.GuidesLayer.CreateGuideAngle(mx, my, 90#)
'MsgBox S1GUIDE.ZOrder & " " & S2GUIDE.ZOrder
S1.Delete
S2.Delete
S3.Delete

Exit Sub
errorh:
MsgBox "Select triangle!"
End Sub
Private Sub extend_line()
Dim sss As Shape
Set sss = ActiveShape
'Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
'x1 = s.Curve.Nodes(1).PositionX
'MsgBox s.Curve.Length
On Error GoTo errorh
mx1 = sss.Curve.Nodes(1).PositionX
my1 = sss.Curve.Nodes(1).PositionY
mx2 = sss.Curve.Nodes(2).PositionX
my2 = sss.Curve.Nodes(2).PositionY
'mdelta = 1 / 2.54 'cm
If tbDelta.Value = "" Then
mdelta = 10
Else
mdelta = tbDelta.Value
End If
mlength = sss.Curve.Length
'MsgBox s.Curve.Length
'Set s = ActiveShape
's.Curve.Nodes(2).PositionX = s.Curve.Nodes(2).PositionX + 1 / 2.54
'sss.Curve.Nodes(2).PositionX = ((mlength + mdelta) / mlength) * mx
'sss.Curve.Nodes(2).PositionY = ((mlength + mdelta) / mlength) * my
'MsgBox mx2 - mx1
sss.Curve.Nodes(2).PositionX = (((mlength + mdelta) * (mx2 - mx1)) / mlength) + mx1
sss.Curve.Nodes(2).PositionY = (((mlength + mdelta) * (my2 - my1)) / mlength) + my1
' sss.Curve.ReverseDirection
' sss.Curve.Nodes(2).PositionX = (((mlength + mdelta) * (mx2 - mx1)) / mlength) + mx1
' sss.Curve.Nodes(2).PositionY = (((mlength + mdelta) * (my2 - my1)) / mlength) + my1
Exit Sub
errorh:
MsgBox "SELECT LINE AND TRY AGAIN!"
End Sub