Fill a shape with Circles

[runflacruiser]

Hi.
Yep, This is an old one, but a fun one.
Here's a quick add to the script above. I don't have much time left tonight so I figured I'd at least give you something to play with. I didn't do the exact math on it yet either.

Later I'll redo the entire thing.

-John

Option Explicit

Sub fillWithCircles()

    Dim container As Shape, circles As Shape
    Dim lilCircle As Shape, lilCircle2 As Shape, rowShAdd As Shape, tempSh1 As Shape
    Dim x#, y#, h#, w#, w1#, h1#
    Dim x1#, y1#
    Dim dia#, space#, marg#
    Dim amountStacked As Long
    Dim amountRows As Long, totalCircles As Long
    Dim i As Integer
    Dim circlesSR As New ShapeRange
    Dim ContainerSr As New ShapeRange
    Dim finalCirclesSr2 As New ShapeRange
    Dim newCircle As Shape, newCircle2 As Shape
    Dim finalCircleS As Shape, sTemp As Shape, finalCircleS2 As Shape, rowSh As Shape
    Dim crspt As CrossPoints
    Dim tempSr1 As ShapeRange, finalCirclesSr As ShapeRange
    Dim a#, b#, c#

    ActiveDocument.BeginCommandGroup "fill with circles"
    
    dia = 0.2 'set your circle (or any shape) diameter here
    space = 0.1 'spacing between circles
    marg = 0.01 ' just a starting point
    
'get the active selection and add it to a shaperange and get it's bounding box
    Set container = getSelectionShapes(True).Shapes(1)
    container.ConvertToCurves 'convert it to curves so we can detect crosspoints later.
    ContainerSr.Add container
    ContainerSr(1).GetBoundingBox x, y, w, h
    
'create the first and 2nd shape (staggered shapes)
'add it to it's own shaperange for circles
'create whatever shape you want here -- or 2 different shapes!!!

    a = (dia / 2) + (space / 2)
    c = dia + space
    b = Sqr(c ^ 2 - a ^ 2) ' side we need to calculate

'fill with circles
    'Set lilCircle = ActiveLayer.CreateEllipse2(x + (dia / 2) + marg, y + (dia / 2) + marg, dia / 2)
    'Set lilCircle2 = lilCircle.Duplicate(b, a)
    
    
'fill with stars
'    Set lilCircle = ActiveLayer.CreatePolygon2(x + (dia / 2) + marg, y + (dia / 2) + marg, dia / 2, 5, , , True)
'    Set lilCircle2 = ActiveLayer.CreatePolygon2(x + (dia / 2) + marg + b, y + (marg / 2), dia / 2, 5, , , True)
'    Set lilCircle = lilCircle.Weld(lilCircle, False, False)
'    Set lilCircle2 = lilCircle2.Weld(lilCircle2, False, False)
    
'fillwith whatever
    Set lilCircle = getSelectionShapes.Shapes(1)
    lilCircle.SetPosition x, y
    'lilCircle.GetSize w1, h1
    
'how many fit in height
    amountStacked = (h - (marg * 2)) / (dia + space)
    
'create first row vertically
    For i = 1 To (amountStacked - 1)
        Set newCircle = lilCircle.Duplicate
        lilCircle.Move 0, dia + space
        newCircle.AddToSelection
        lilCircle.AddToSelection
    Next i

'create 2nd (staggered) row
'    For i = 1 To (amountStacked)
'        Set newCircle2 = lilCircle2.Duplicate
'        lilCircle2.Move 0, dia + space
'        newCircle2.AddToSelection
'        lilCircle2.AddToSelection
'    Next i

'group all the shapes we created and set them assign to a shape
    ActiveSelection.Group
    Set circles = ActiveSelection
    circles.AlignToShape cdrAlignVCenter, ContainerSr(1)
    circles.GetSize w1, h1
    amountRows = ((w - (marg * 2)) / (w1 + b)) + 1
    Set rowSh = circles.Combine
    
'now create rows across horizontally...
    For i = 1 To amountRows + 2
        Set rowShAdd = rowSh.Duplicate
        rowSh.Move b * 2, 0
        circlesSR.Add rowShAdd
    Next i
    circlesSR.Add rowSh
    circlesSR.CreateSelection
  
    Set tempSr1 = ActiveSelection.UngroupAllEx
    tempSr1.CreateSelection

'align the group of shapes to center of container horizontally
    Set tempSh1 = ActiveSelection.Combine
    tempSh1.AlignToShape cdrAlignHCenter, ContainerSr(1)

    Set finalCircleS = ActiveSelection.Shapes.All.Combine
    Set finalCirclesSr = finalCircleS.BreakApartEx
    
'find intersecting shapes and delete
    For Each sTemp In finalCirclesSr
        Set crspt = sTemp.Curve.SubPaths(1).GetIntersections(ContainerSr(1).Curve.SubPaths(1))
        If crspt.count > 0 Then
            sTemp.Delete
        Else
            sTemp.AddToSelection
        End If
        
    Next sTemp
'remove the rest that lay outside of container
    Set finalCircleS2 = ActiveSelection.Shapes.All.Combine
    finalCircleS2.Intersect ContainerSr(1), False, True
    
    ActiveDocument.EndCommandGroup
    
End Sub

Private Function getSelectionShapes(Optional bIsContainer As Boolean) As ShapeRange 'just get the two shapes
    Dim Shift As Long
    Dim bClick As Boolean
    Dim s As Shape
    Dim x#, y#, dTol#
    dTol = 0.1 ' select shape tolerance
    ActiveDocument.ClearSelection
    Set getSelectionShapes = CreateShapeRange
    
    If bIsContainer Then
        MsgBox "Select container"
    Else
        MsgBox "Select shape that will go inside the container"
    End If
retrySelectPath:
    While Not bClick
        bClick = False
        bClick = ActiveDocument.GetUserClick(x, y, Shift, 10, False, cdrCursorEyeDrop)
        
        If Not bClick Then
          Set s = ActivePage.SelectShapesAtPoint(x, y, True, dTol)
        End If
    
        If s.Shapes.count < 1 Then
            Dim mRetry As Integer
            mRetry = MsgBox("No shape selected. Try again?", vbOKCancel, "GDG")
            If mRetry = 1 Then
                GoTo retrySelectPath:
            Else
                'Set getSelectionShapes = Nothing
                Exit Function
            End If
        End If
        getSelectionShapes.Add s.Shapes(1)
        If getSelectionShapes.Shapes.count = 1 Then GoTo exitLoop:
    Wend
exitLoop:
End Function

Originally Posted by biok

Hi, does anyone know how to fill a shape with circles of the same size and sprayed with the same separation between them all along the shape. Something like the Artistic Media tool with the outlines, but the Artistic Media is not supported in VBA.

LEDTool 4 does that and much more:

http://macromonster.com/index.php?mo...r&id_desc=139&

[buga]

wow thank you very much again. a great code.
I suggest a couple of implementations that would be cool.

1 - 1 - the scale of the circles or the shape could be random. ie circles of different sizes by filling out the shape completely (perhaps from a scale of 100-200)and the circles fill the shape perfectly

2 - to fill the shape with different mixed forms. bone, you can select 5 different shapes, put them in an array, and be taking one shape or another at random to fill out the shape completely

would be really cool?

Greetings and congratulations again for your code

It's possible with ecut, for nesting.

http://macromonster.com/index.php?mod=descr&id_desc=109
Create random sizes in advance then use it to nest inside another shape, with various "fixed" angles you can decide: