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 sr.Delete Optimization = False ActiveWindow.RefreshActiveDocument.EndCommandGroupEnd Sub
Your macro draws an ellipse very similar but not identical to the originalHere is my version of this macro belowThere is also a condition that the nodes of the curve must be standard as when converting an ellipse into a curve.TarasSub 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 s1.Delete Set s1 = ActiveLayer.CreateEllipse2(0, 0, R1, R2) s1.Rotate kut s1.CenterX = XC s1.CenterY = YC Next s SR.Delete End SubFunction 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
Thanks Taras.SoftLV
Works great.