美丽的数学 之 彩色的灌木丛

lee1892

这是像花还是像灌木丛多些？


这样子是不是很有立体感呀



哈哈，这个实在是太有意思啦！看后面的，告诉你怎么变化~




追加一个带参数操作界面的附件：


美丽的数学系列的前一个帖子：雪花




补充内容 (2013-12-14 14:36):
感兴趣的去看这个帖子：美丽的数学 之 奇妙的分形

kuangben8

支持原创分享！图表制作的精美。

lee1892

在代码里有一个生成子节点的过程，稍改动会生成不同的图案，非常有趣：

1、像不像窗花：
[code=vb]Private Sub GetChildren(ByVal nRoot&, ByVal iLayer%, ByVal nPlus%)
    Dim nChild&, nNext&, dAngle#, dLength#, dX#, dY#
    nChild = nRoot + 2 ^ (iLayer - 1)
    With arrVertex(nRoot)
        nNext = .Next: .Next = nChild
        .Length = .Length * Sqr(2) / 2: dLength = .Length
        dAngle = .Angle: .Angle = .Angle - Pi / 4 '* nPlus <- 不改变方向
        dX = .X + .Length * Cos(.Angle)
        dY = .Y + .Length * Sin(.Angle)
    End With
    With arrVertex(nChild)
        .X = dX: .Y = dY: .Length = dLength: .Angle = dAngle + Pi / 4 * nPlus
        .Next = nNext
    End With
End Sub[/code]


2、另一种灌木丛？
[code=vb]Private Sub GetChildren(ByVal nRoot&, ByVal iLayer%, ByVal nPlus%)
    Dim nChild&, nNext&, dAngle#, dLength#, dX#, dY#
    nChild = nRoot + 2 ^ (iLayer - 1)
    With arrVertex(nRoot)
        nNext = .Next: .Next = nChild
        .Length = .Length * Sqr(2) / 2: dLength = .Length
        dAngle = .Angle: .Angle = .Angle - Pi / 4 * nPlus
        dX = .X + .Length * Cos(.Angle)
        dY = .Y + .Length * Sin(.Angle)
    End With
    With arrVertex(nChild)
        .X = dX: .Y = dY: .Length = dLength: .Angle = dAngle + Pi / 4 '* nPlus <- 不改变方向
        .Next = nNext
    End With
End Sub[/code]


3、钩子？
[code=vb]Private Sub GetChildren(ByVal nRoot&, ByVal iLayer%, ByVal nPlus%)
    Dim nChild&, nNext&, dAngle#, dLength#, dX#, dY#
    nChild = nRoot + 2 ^ (iLayer - 1)
    With arrVertex(nRoot)
        nNext = .Next: .Next = nChild
        .Length = .Length * Sqr(2) / 2: dLength = .Length
        dAngle = .Angle: .Angle = .Angle - Pi / 4 '* nPlus <- 不改变方向
        dX = .X + .Length * Cos(.Angle)
        dY = .Y + .Length * Sin(.Angle)
    End With
    With arrVertex(nChild)
        .X = dX: .Y = dY: .Length = dLength: .Angle = dAngle + Pi / 4 '* nPlus <- 不改变方向
        .Next = nNext
    End With
End Sub[/code]

lee1892

还可以在这个生成子节点的过程，更改不同的角度，得到不同的图案，有意思极了

先把 输出过程 改动一下：
[code=vb]Private Sub Output(ByVal iIndex%, Optional bWait As Boolean = False)
    Dim i&, n&
    i = 1
    Do
        With arrVertex(i)
            arrOutput(n, 0) = .X: arrOutput(n, 1) = .Y: i = .Next
        End With
        n = n + 1
    Loop Until i = 0 '<- 这里改为 0 ，去掉末尾的那个点
    Range("A2").Offset(0, 2 * (7 - iIndex)).Resize(UBound(arrOutput) + 1, 2) = arrOutput
    If bWait Then WaitMoment 0.2
End Sub[/code]
[code=vb]Private Sub cmdData_Click()[/code]
里有 8 段 With，可以只留第 1 个 和 第 5 个，只观察生成一个图案的情况。

纵横坐标调整的时候，保持比例一致。比如我就都调成 -2~2。

1、像不像云？
[code=vb]Private Sub GetChildren(ByVal nRoot&, ByVal iLayer%, ByVal nPlus%)
    Dim nChild&, nNext&, dAngle#, dLength#, dX#, dY#
    nChild = nRoot + 2 ^ (iLayer - 1)
    With arrVertex(nRoot)
        nNext = .Next: .Next = nChild
        .Length = .Length * Sqr(2) / 2: dLength = .Length
        dAngle = .Angle: .Angle = .Angle - Pi / 3 '* nPlus <-不改变方向，转60度
        dX = .X + .Length * Cos(.Angle)
        dY = .Y + .Length * Sin(.Angle)
    End With
    With arrVertex(nChild)
        .X = dX: .Y = dY: .Length = dLength: .Angle = dAngle + Pi / 9 '* nPlus <- 不改变方向，转20度
        .Next = nNext
    End With
End Sub[/code]


2、这个像蝎子？
[code=vb]Private Sub GetChildren(ByVal nRoot&, ByVal iLayer%, ByVal nPlus%)
    Dim nChild&, nNext&, dAngle#, dLength#, dX#, dY#
    nChild = nRoot + 2 ^ (iLayer - 1)
    With arrVertex(nRoot)
        nNext = .Next: .Next = nChild
        .Length = .Length * Sqr(2) / 2: dLength = .Length
        dAngle = .Angle: .Angle = .Angle - Pi / 3 * nPlus ' 转 60度
        dX = .X + .Length * Cos(.Angle)
        dY = .Y + .Length * Sin(.Angle)
    End With
    With arrVertex(nChild)
        .X = dX: .Y = dY: .Length = dLength: .Angle = dAngle + Pi / 9 * nPlus ' 转20度
        .Next = nNext
    End With
End Sub[/code]




3、海浪？
[code=vb]Private Sub GetChildren(ByVal nRoot&, ByVal iLayer%, ByVal nPlus%)
    Dim nChild&, nNext&, dAngle#, dLength#, dX#, dY#
    nChild = nRoot + 2 ^ (iLayer - 1)
    With arrVertex(nRoot)
        nNext = .Next: .Next = nChild
        .Length = .Length * Sqr(2) / 2: dLength = .Length
        dAngle = .Angle: .Angle = .Angle - Pi / 4 '* nPlus
        dX = .X + .Length * Cos(.Angle)
        dY = .Y + .Length * Sin(.Angle)
    End With
    With arrVertex(nChild)
        .X = dX: .Y = dY: .Length = dLength: .Angle = dAngle + Pi / 20 '* nPlus
        .Next = nNext
    End With
End Sub[/code]


4、古怪的植物？
[code=vb]Private Sub GetChildren(ByVal nRoot&, ByVal iLayer%, ByVal nPlus%)
    Dim nChild&, nNext&, dAngle#, dLength#, dX#, dY#
    nChild = nRoot + 2 ^ (iLayer - 1)
    With arrVertex(nRoot)
        nNext = .Next: .Next = nChild
        .Length = .Length * Sqr(2) / 2: dLength = .Length
        dAngle = .Angle: .Angle = .Angle - Pi / 4 * nPlus
        dX = .X + .Length * Cos(.Angle)
        dY = .Y + .Length * Sin(.Angle)
    End With
    With arrVertex(nChild)
        .X = dX: .Y = dY: .Length = dLength: .Angle = dAngle + Pi / 20 '* nPlus
        .Next = nNext
    End With
End Sub[/code]

踏雪访梅

真了不起呀。膜拜！

淡墨清荷

神奇的图表

微笑king

tai qiangdale .buganduokan

cd37ycs

支持原创分享！图表制作的精美。