My macro to replace ellipses that were converted to curves back to ellipses

Create an ellipse (oval), rotate it 15deg, convert it to curves.

I created this macro to replace the shape with an ellipse but would like to add to it. I'd like to get the angle of rotation of the shape then after the shape is replaced have it rotate it to what it was.

Could probably be streamlined too but beyond my code hacking skills.

Sub ConvertCirclesBack()
Dim sr As ShapeRange, s As Shape
Dim x#, y#, w#, h#, dOffset#
ActiveDocument.BeginCommandGroup ("Convert")
Set sr = ActiveSelectionRange
If sr.Shapes.Count < 1 Then
MsgBox "Select at least one shape"
Exit Sub
End If
Optimization = True
ActiveDocument.Unit = cdrInch
If sr.Count = 0 Then Exit Sub
For Each s In sr
s.GetBoundingBox x, y, w, h
Set s = ActiveLayer.CreateEllipse2(x + w / 2, y + h / 2, w / 2, h / 2)
s.Flip cdrFlipVertical
Next s
Optimization = False
End Sub

  • Your macro draws an ellipse very similar but not identical to the original
    Here is my version of this macro below
    There is also a condition that the nodes of the curve must be standard as when converting an ellipse into a curve.


    Sub TV_CirclesBack()
    Dim SR As ShapeRange, s As Shape, s1 As Shape, kut As Double
    Dim X1 As Double, Y1 As Double, X2 As Double, Y2 As Double
    Dim XC As Double, YC As Double, R1 As Double, R2 As Double

    ActiveDocument.Unit = cdrMillimeter

    Set SR = ActiveSelectionRange

    For Each s In SR

    XC = s.CenterX
    YC = s.CenterY

    X1 = s.Curve.Nodes(1).PositionX
    Y1 = s.Curve.Nodes(1).PositionY

    R1 = Distance(X1, Y1, XC, YC)

    X2 = s.Curve.Nodes(2).PositionX
    Y2 = s.Curve.Nodes(2).PositionY

    R2 = Distance(X2, Y2, XC, YC)

    Set s1 = ActiveLayer.CreateLineSegment(X1, Y1, XC, YC)
    kut = s1.Curve.Segments(1).StartingControlPointAngle

    Set s1 = ActiveLayer.CreateEllipse2(0, 0, R1, R2)
    s1.Rotate kut

    s1.CenterX = XC
    s1.CenterY = YC
    Next s

    End Sub
    Function Distance(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double)
    Distance = Sqr(Abs(X2 - X1) ^ 2 + Abs(Y2 - Y1) ^ 2)
    End Function

Reply Children
No Data