Did a trace on a JPG which converted the hundreds of circles to squares/rectangles/random curves. I cannot find anything that allows me to replace the white curves with pink circles/ellipses. There are too many to do it manually with copy-paste & align. Sample area, shown.
I have a macro to do just that. Also have one to create rectangles.
Willing to share the macros or let us know how you set them up?
It's not bad, if one can live with the limitation of simply having the ellipse match the width and height of the shape.
Sub replace_shapes_with_ellipses() Dim sr As ShapeRange Dim srCreated As New ShapeRange Dim s As Shape For Each s In ActiveSelectionRange srCreated.Add ActiveLayer.CreateEllipse(s.LeftX, s.TopY, s.RightX, s.BottomY) s.Delete Next s srCreated.CreateSelection End Sub
So, it's not creating rotated ellipses. Also, it's not trying to be smart about putting the new shapes in the stacking order at the same places as the shapes that are being replaced. Also, no error handling, no checking whether any objects are selected, no checks for zero-height or zero-width objects, no optimization or disabling of events, and no commandgroup. It's just enough to show how I created the ellipses.
Not sure it's exactly what you're after. The ellipses are made according to the ht and width of each shape so you end up with some "ovals" in there too. Wouldn't be hard to modify to create perfect circles in place of each. This was developed for dxf files. Imported dxf circles are actually straight line segments connected in such a way as to look like a circle. This little macro converts them all back to usable ellipses
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
Myron, thank you for this. I'll try it out. I just finished a job that had to be saved as DXF and noticed some conversion issues. But it worked out okay. Anxious to try your Macros, when I get a chance.