Find the center point of a EllipticalArcTo row in the Geometry Section

[RhesusMinus]

Hi.

Can anyone help med to calculate the center point for an EllipticalArcTo row?

I need to programatically insert a connection point into this center point.

THL

[Nikolay]

By "center point" you mean the center of the ellipse this arc is a part of, or the point on the arc located at equal distances from the begin/end points of the arc?

[RhesusMinus]

Hi.

I mean the center point of the elipse this elliptical arc is a part of.

The Ellipse geometry has a center point already, so it wasn't any trouble getting those.
But.. an elliptical arc only have 3 coordinates (start point, "via" point and End point), so I guess I have to calculate the center point manually.
If I only paid attention in school

THL

[Nikolay]

Then probably this excellent work of Junichi will be helpful:

http://visguy.com/vgforum/index.php?topic=880.0

[nashwaan]

Hi RhesusMinus,

If i understand your question correctly, then the following code should do the work:

Code Select Expand


Option Explicit



Public Function FindCenterOfEllipticalArc(shp As Visio.Shape, iSectionGeometry As Integer, iRowEllipticalArc As Integer, _
                                          Optional bAlsoMajorAndMinor As Boolean = False) As Integer
' Thanks to Junichi Yoda "Closing Elliptical Arc" - http://visguy.com/vgforum/index.php?topic=880.0
' Abstract: Calculate the center of the ellipse that encloses an elliptical arc.
'           Also, can calculate the major and minor axes of the enclosing ellipse.
'           This procedure adds a scratch row to do the calculations. The center of
'           the enclosing ellipse is in the X and Y of the scratch row. The major and
'           minor axes (if required) are in the A and B of the next scratch row.
'           This procedure returns the index of the scratch row that contains the result.
' Parameters:
'   * shp: the shape that contains at least one elliptical arc geometry.
'   * iSectionGeometry: the geometry section that contains the elliptical arc.
'   * iRowEllipticalArc: the row in the geometry section that contains the elliptical arc.
' Immediate: ?FindCenterOfEllipticalArc(ActiveWindow.Selection(1), visSectionFirstComponent, visRowVertex + 1)
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    '// do few checks first
    If shp Is Nothing Then Exit Function
    If shp.SectionExists(iSectionGeometry, False) = False Then Exit Function
    If iSectionGeometry < Visio.visSectionFirstComponent Or iSectionGeometry > Visio.visSectionLastComponent Then Exit Function
    If shp.RowExists(iSectionGeometry, iRowEllipticalArc, False) = False Then Exit Function
    If shp.RowType(iSectionGeometry, iRowEllipticalArc) <> Visio.visTagEllipticalArcTo Then Exit Function
    If shp.RowType(iSectionGeometry, iRowEllipticalArc - 1) = Visio.visTagComponent Then Exit Function
   
    '// start undo scope to encapsulate all commands as a single operation
    Dim nUndoScopeID As Long
    nUndoScopeID = shp.Application.BeginUndoScope("~Find Center of Elliptical Arc")
   
    '// declare variables for points on the elliptical arc {P1, P2, P3} and inclination angle of the enclosing ellipse
    Dim X1 As String, Y1 As String
    Dim X2 As String, Y2 As String
    Dim X3 As String, Y3 As String
    Dim Ang As String, D  As String
   
    '// get reference to the starting point of the elliptical arc: P1
    X1 = shp.CellsSRC(iSectionGeometry, iRowEllipticalArc - 1, Visio.visX).Name
    Y1 = shp.CellsSRC(iSectionGeometry, iRowEllipticalArc - 1, Visio.visY).Name
   
    '// get reference to the ending point of the elliptical arc: P2
    X2 = shp.CellsSRC(iSectionGeometry, iRowEllipticalArc, Visio.visX).Name
    Y2 = shp.CellsSRC(iSectionGeometry, iRowEllipticalArc, Visio.visY).Name
   
    '// get reference to the control point of the elliptical arc: P3
    X3 = shp.CellsSRC(iSectionGeometry, iRowEllipticalArc, Visio.visControlX).Name
    Y3 = shp.CellsSRC(iSectionGeometry, iRowEllipticalArc, Visio.visControlY).Name
   
    '// get reference to the inclination angle of the enclosing ellipse
    Ang = shp.CellsSRC(iSectionGeometry, iRowEllipticalArc, Visio.visEccentricityAngle).Name
   
    '// get reference to the aspect ratio of the enclosing ellipse: D
    D = shp.CellsSRC(iSectionGeometry, iRowEllipticalArc, visAspectRatio).Name
   
    '// add a scratch row for calculating the center of the enclosing ellipse
    Dim iRowScratch As Integer
    iRowScratch = shp.AddRow(Visio.visSectionScratch, Visio.visRowLast, Visio.visTagDefault)
   
    '// calculate P1 with respect to the inclined enclosing ellipse
    Dim celP1 As Visio.Cell
    Set celP1 = shp.CellsSRC(Visio.visSectionScratch, iRowScratch, Visio.visScratchA)
    celP1.FormulaU = "PNT(SQRT(" & X1 & "^2+" & Y1 & "^2)*COS(ATAN2(" & Y1 & "," & X1 & ")-" & Ang & ")" & _
                   "," & "SQRT(" & X1 & "^2+" & Y1 & "^2)*SIN(ATAN2(" & Y1 & "," & X1 & ")-" & Ang & ")" & ")"
   
    '// calculate P2 with respect to the inclined enclosing ellipse
    Dim celP2 As Visio.Cell
    Set celP2 = shp.CellsSRC(Visio.visSectionScratch, iRowScratch, Visio.visScratchB)
    celP2.FormulaU = "PNT(SQRT(" & X2 & "^2+" & Y2 & "^2)*COS(ATAN2(" & Y2 & "," & X2 & ")-" & Ang & ")" & _
                   "," & "SQRT(" & X2 & "^2+" & Y2 & "^2)*SIN(ATAN2(" & Y2 & "," & X2 & ")-" & Ang & ")" & ")"
   
    '// calculate P3 with respect to the inclined enclosing ellipse
    Dim celP3 As Visio.Cell
    Set celP3 = shp.CellsSRC(Visio.visSectionScratch, iRowScratch, Visio.visScratchC)
    celP3.FormulaU = "PNT(SQRT(" & X3 & "^2+" & Y3 & "^2)*COS(ATAN2(" & Y3 & "," & X3 & ")-" & Ang & ")" & _
                   "," & "SQRT(" & X3 & "^2+" & Y3 & "^2)*SIN(ATAN2(" & Y3 & "," & X3 & ")-" & Ang & ")" & ")"
   
    '// get x and y of P1
    X1 = "PNTX(" & celP1.Name & ")"
    Y1 = "PNTY(" & celP1.Name & ")"
   
    '// get x and y of P2
    X2 = "PNTX(" & celP2.Name & ")"
    Y2 = "PNTY(" & celP2.Name & ")"
   
    '// get x and y of P3
    X3 = "PNTX(" & celP3.Name & ")"
    Y3 = "PNTY(" & celP3.Name & ")"
   
    ' x0 = ((x1-x2)*(x1+x2)*(y2-y3)-(x2-x3)*(x2+x3)*(y1-y2)+D^2*(y1-y2)*(y2-y3)*(y1-y3))/(2*((x1-x2)*(y2-y3)-(x2-x3)*(y1-y2)))
    '// construct the X center of the inclined enclosing ellipse: X0
    Dim X0 As String
    X0 = "(" & "(" & X1 & "-" & X2 & ")*(" & X1 & "+" & X2 & ")*(" & Y2 & "-" & Y3 & ")-" & _
               "(" & X2 & "-" & X3 & ")*(" & X2 & "+" & X3 & ")*(" & Y1 & "-" & Y2 & ")+" & _
        D & "^2*(" & Y1 & "-" & Y2 & ")*(" & Y2 & "-" & Y3 & ")*(" & Y1 & "-" & Y3 & ")" & ")"
    X0 = X0 & "/(2*(" & "(" & X1 & "-" & X2 & ")*(" & Y2 & "-" & Y3 & ")-" & _
                        "(" & X2 & "-" & X3 & ")*(" & Y1 & "-" & Y2 & ")" & "))"
   
    ' y0 = ((x1-x2)*(x2-x3)*(x1-x3)/D^2+(x2-x3)*(y1-y2)*(y1+y2)-(x1-x2)*(y2-y3)*(y2+y3))/(2*((x2-x3)*(y1-y2)-(x1-x2)*(y2-y3)))
    '// construct the Y center of the inclined enclosing ellipse: Y0
    Dim Y0 As String
    Y0 = "(" & "(" & X1 & "-" & X2 & ")*(" & X2 & "-" & X3 & ")*(" & X1 & "-" & X3 & ")/" & D & "^2+" & _
               "(" & X2 & "-" & X3 & ")*(" & Y1 & "-" & Y2 & ")*(" & Y1 & "+" & Y2 & ")-" & _
               "(" & X1 & "-" & X2 & ")*(" & Y2 & "-" & Y3 & ")*(" & Y2 & "+" & Y3 & ")" & ")"
    Y0 = Y0 & "/(2*(" & "(" & X2 & "-" & X3 & ")*(" & Y1 & "-" & Y2 & ")-" & _
                        "(" & X1 & "-" & X2 & ")*(" & Y2 & "-" & Y3 & ")" & "))"
   
    '// put the x and y formulas of the center of the inclined enclosing ellipse: P0 (X0, Y0)
    Dim celP0 As Visio.Cell
    Set celP0 = shp.CellsSRC(Visio.visSectionScratch, iRowScratch, Visio.visScratchD)
    celP0.FormulaU = "PNT(" & X0 & "," & Y0 & ")"
   
    '// get x and y of P0
    X0 = "PNTX(" & celP0.Name & ")"
    Y0 = "PNTY(" & celP0.Name & ")"
   
    '// calculate back the X0 with respect to shp
    Dim celX0 As Visio.Cell
    Set celX0 = shp.CellsSRC(Visio.visSectionScratch, iRowScratch, Visio.visScratchX)
    celX0.FormulaU = "SQRT(" & X0 & "^2+" & Y0 & "^2)*COS(ATAN2(" & Y0 & "," & X0 & ")+" & Ang & ")"
   
    '// calculate back the Y0 with respect to shp
    Dim celY0 As Visio.Cell
    Set celY0 = shp.CellsSRC(Visio.visSectionScratch, iRowScratch, Visio.visScratchY)
    celY0.FormulaU = "SQRT(" & X0 & "^2+" & Y0 & "^2)*SIN(ATAN2(" & Y0 & "," & X0 & ")+" & Ang & ")"
   
    '// check it is required to calculate the major and minor axes of the enclosing ellipse
    If bAlsoMajorAndMinor = True Then
       
        '// add a scratch row for calculating the center of the enclosing ellipse
        Call shp.AddRow(Visio.visSectionScratch, Visio.visRowLast, Visio.visTagDefault)
       
        '// get reference to scratch cells where the major and minor results will be stored
        Dim celMajor As Visio.Cell, celMinor As Visio.Cell
        Set celMajor = shp.CellsSRC(Visio.visSectionScratch, iRowScratch + 1, Visio.visScratchA)
        Set celMinor = shp.CellsSRC(Visio.visSectionScratch, iRowScratch + 1, Visio.visScratchB)
       
        '// calculate major and minor axes:   a = sqrt{ (x1-x0)^2 + (y1-y0)^2 * D^2 }
        celMajor.FormulaU = "SQRT((" & X1 & "-" & X0 & ")^2+(" & Y1 & "-" & Y0 & ")^2*" & D & "^2)"
        celMinor.FormulaU = celMajor.Name & "/" & D     ' b = a / D
       
    End If
   
    '// end undo scope
    Call shp.Application.EndUndoScope(nUndoScopeID, True)
   
    '// return the position of the scratch row that contains P0: (X0, Y0)
    FindCenterOfEllipticalArc = iRowScratch + 1
   
End Function


Yousuf.

[nashwaan]

A test procedure for the previous code (copy this procedure and the procedure from my previous reply into a single VBA module):

Code Select Expand


Public Sub TestFindCenterOfEllipticalArc()
' Abstract: Test FindCenterOfEllipticalArc().
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    '// create new document
    Dim pag As Page
    With Application.Documents.Add("")
        Set pag = .Pages(1)
    End With
   
    '// draw an arc
    Dim shpArc As Shape
    Set shpArc = pag.DrawArcByThreePoints(2, 3, 4, 5, 3, 2)
    shpArc.CellsSRC(visSectionFirstComponent, 2, visAspectRatio).FormulaU = "1.5"
   
    '// calculate center of the arc and get the scratch row that contains this info
    Dim iScratchRow As Integer, strPNT As String
    iScratchRow = FindCenterOfEllipticalArc(shpArc, visSectionFirstComponent, visRowVertex + 1, True)
    strPNT = "PNT(" & shpArc.NameID & "!Scratch.X" & iScratchRow & "," & shpArc.NameID & "!Scratch.Y" & iScratchRow & ")"
   
    '// draw a small circle and position it in the center of the arc (using calculated center)
    Dim shpCircle As Shape
    Set shpCircle = pag.DrawOval(1, 1, 1.15, 1.15)
    shpCircle.CellsU("PinX").FormulaU = "GUARD(LOCTOPAR(" & strPNT & "," & shpArc.NameID & "!Width,Width))"
    shpCircle.CellsU("PinY").FormulaU = "GUARD(LOCTOPAR(" & strPNT & "," & shpArc.NameID & "!Width,Width))"
    shpCircle.CellsU("FillPattern").FormulaU = 0
    shpCircle.CellsU("LineColor").FormulaU = "THEMEGUARD(RGB(192,0,0))" ' dark red
    Call shpCircle.SendToBack
   
    '// draw an ellipse that encloses the elliptical arc (using calculated center)
    Dim shpEllipse As Shape, strX1X0_2 As String, strY1Y0_2 As String
    Set shpEllipse = pag.DrawOval(1, 1, 2, 2)
    shpEllipse.CellsU("PinX").FormulaU = "GUARD(LOCTOPAR(" & strPNT & "," & shpArc.NameID & "!Width,Width))"
    shpEllipse.CellsU("PinY").FormulaU = "GUARD(LOCTOPAR(" & strPNT & "," & shpArc.NameID & "!Width,Width))"
    strX1X0_2 = "(PNTX(" & shpArc.NameID & "!Scratch.A" & iScratchRow & ")-PNTX(" & shpArc.NameID & "!Scratch.D" & iScratchRow & "))^2"
    strY1Y0_2 = "(PNTY(" & shpArc.NameID & "!Scratch.A" & iScratchRow & ")-PNTY(" & shpArc.NameID & "!Scratch.D" & iScratchRow & "))^2"
    shpEllipse.CellsU("Width").FormulaU = "GUARD(2*SQRT(" & strX1X0_2 & "+" & strY1Y0_2 & "*" & shpArc.NameID & "!Geometry1.D2^2))" ' a = sqrt{ (x1-x0)^2 + (y1-y0)^2 * D^2 }
    shpEllipse.CellsU("Height").FormulaU = "GUARD(Width/" & shpArc.NameID & "!Geometry1.D2)" ' b = a / D
    ' or uncomment the following two lines
'    shpEllipse.CellsU("Width").FormulaForceU = "GUARD(2*" & shpArc.NameID & "!Scratch.A" & iScratchRow + 1 & ")"
'    shpEllipse.CellsU("Height").FormulaForceU = "GUARD(2*" & shpArc.NameID & "!Scratch.B" & iScratchRow + 1 & ")"
    shpEllipse.CellsU("Angle").FormulaU = "GUARD(" & shpArc.NameID & "!Angle+" & shpArc.NameID & "!Geometry1.C2)"
    shpEllipse.CellsU("FillPattern").FormulaU = 0
    shpEllipse.CellsU("LineColor").FormulaU = "THEMEGUARD(MSOTINT(RGB(255,255,255),-25))" ' light grey
    Call shpEllipse.SendToBack
   
End Sub


More explanation can be found here.

Yousuf.