circle packing in excel vba

debugcn Published at Dev

Lani

I want to fit n circles of the same radius (r1) along the inside edge of a circle with radius (r) so that each inner circle touches the next. For some reason i keep getting a error, and i cannot figure out how to make it work... Any ideas on that?

Sub CirclePacking()

Dim n As Integer
Dim r As Double
Dim r1 As Double

  r = 2000

Dim centre_X As Double
Dim centre_Y As Double
   centre_X = r
   centre_Y = r  

Const pi = 3.14159265358979         '180°
Const pi2 = 3.14159265358979 * 2    '360°
Const pi_d2 = 3.14159265358979 / 2  ' 90°
Dim radians_per_circle As Double
Dim ang As Double
Dim i As Long
Dim s As Double

  For n = 1 To 20
    Set Shape_1 = Shapes.AddShape(18, centre_X, centre_Y, r, r)
    Shape_1.Name = "Project"
        With Shape_1
            .Fill.Visible = msoFalse
            .Line.ForeColor.SchemeColor = 0
            .Line.Weight = 8
        End With

                  'find radians (of outer circle) per inner circle
    radians_per_circle = pi2 / n

                  'find radius of inner circle
    s = Sin(radians_per_circle / 2)
    r1 = (r * s) / (s + 1)

    For i = 0 To n
      ang = (radians_per_circle * i) - pi_d2

      Set Shape_2 = Shapes.AddShape(18, centre_X + (Cos(ang) * (r - r1)), centre_Y + (Sin(ang) * (r - r1)), r1, r1)

    Next i

    MsgBox n
  Next n

End Sub

user3598756

Shapes is a collection of Shape objects you can obtain by invoking Shapes property of any Worksheet object

so you need a valid Worksheet reference to precede .Shapes, like, for instance, ActiveSheet:

Option Explicit

Sub CirclePacking()

    Dim n As Integer
    Dim r As Double
    Dim r1 As Double

      r = 2000

    Dim centre_X As Double
    Dim centre_Y As Double
       centre_X = r
       centre_Y = r

    Const pi = 3.14159265358979         '180°
    Const pi2 = 3.14159265358979 * 2    '360°
    Const pi_d2 = 3.14159265358979 / 2  ' 90°

    Dim radians_per_circle As Double
    Dim ang As Double
    Dim i As Long
    Dim s As Double
    Dim Shape_1 As Shape, Shape_2 As Shape

      For n = 1 To 20
        Set Shape_1 = ActiveSheet.Shapes.AddShape(18, centre_X, centre_Y, r, r)
        Shape_1.name = "Project"
            With Shape_1
                .Fill.Visible = msoFalse
                .Line.ForeColor.SchemeColor = 0
                .Line.Weight = 8
            End With

                      'find radians (of outer circle) per inner circle
        radians_per_circle = pi2 / n

                      'find radius of inner circle
        s = Sin(radians_per_circle / 2)
        r1 = (r * s) / (s + 1)

        For i = 0 To n
          ang = (radians_per_circle * i) - pi_d2

          Set Shape_2 = ActiveSheet.Shapes.AddShape(18, centre_X + (Cos(ang) * (r - r1)), centre_Y + (Sin(ang) * (r - r1)), r1, r1)

        Next i

        MsgBox n
      Next n

End Sub

Collected from the Internet

Please contact [email protected] to delete if infringement.