excel vbaで円パッキング

Question

同じ半径（r1）のn個の円を半径（r）の円の内側の端に沿ってフィットさせて、内側の各円が次の円に接触するようにしたい。 何らかの理由で私はエラーが発生し続けるが、それを動作させる方法を理解することはできない...それに関するアイデアは？

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 

Answer 1

Shapesあなたがそうあなたは、例えば、同様に、.Shapesの前に、有効なWorksheet参照、ActiveSheet必要なすべてのWorksheetオブジェクト

のShapesプロパティを呼び出すことによって取得することができShapeオブジェクトのコレクションです：

を

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