Hello! I'm trying to make a tool which can fill a shape with ellipses with the properties I determine.
My form is looking like this:
Size means ellipse's width and height (same size)
and the distance means the length between circles
This is the code to get info from the shape I selected and create a ellipse. (txtvalue.Text is the textbox size)
and this is the code I use to duplicate ellipse i created. (txtdist. text is the distance textbox)
So the problem here is I want it repeat for just fill the shape and I think If i
divide the width of shape i selected to the size of ellipse plus distance, It must give the
number of filling horizontally. It is not working right, please help me (and i need
to make it vertically then fill the shape too :D)
Select the rectangle and run the code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
Sub TestFillRect() Dim radius As Double, Dist As Double, shRect As Shape, x As Double, y As Double, w As Double, h As Double Dim NoRows As Long, NoColumns As Long, i As Long, shGr As Shape, shCircle As Shape, shC As Shape, sel As Shape ActiveDocument.Unit = cdrMillimeter: Application.Unit = cdrMillimeter radius = 3: Dist = 2 Set shRect = ActiveShape shRect.GetBoundingBox x, y, w, h NoRows = Int(h / (2 * radius + Dist)) NoColumns = Int(w / (2 * radius + Dist)) 'Create the first circle Set shCircle = ActiveLayer.CreateEllipse2(x + radius, y + radius, radius, radius) 'Create first row of circles: For i = 1 To NoColumns shCircle.Duplicate (2 * radius + Dist) * i Next i Set sel = ActivePage.SelectShapesFromRectangle(x - 2 * radius, y + 2 * radius, x + shRect.sizeWidth, y - 2 * radius, False) 'Multiply the creating row on vertical side For i = 1 To NoRows - 1 sel.Duplicate 0, (2 * radius + Dist) * i Next i 'Center the circles on the rectangle: ActiveLayer.Shapes.All.CreateSelection shRect.RemoveFromSelection Set shGr = ActiveSelectionRange.Group shGr.CenterX = shRect.CenterX shGr.CenterY = shRect.CenterY MsgBox "Ready...", , "Job done" End Sub