我希望沿半径为(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
答案 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