在excel vba中圈出包装

时间:2016-09-05 11:37:48

标签: excel vba excel-vba

我希望沿半径为(r)的圆的内边缘拟合相同半径(r1)的n个圆,以便每个内圆接触下一个圆。 由于某种原因,我一直在收到错误,我无法弄清楚如何让它发挥作用...有什么想法吗?

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

1 个答案:

答案 0 :(得分:1)

Shapes是您可以通过调用任何Shapes对象的Worksheet属性获取的Shape个对象的集合

因此您需要在Worksheet之前添加有效的.Shapes引用,例如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