玩一玩简单的分形：二叉分形树

aoe1981 · 发表于 2020-1-12 19:56

本帖最后由 aoe1981 于 2020-1-12 20:51 编辑

本来是这样：

参数是这样：

又或者是这样：

参数折腾成这样：

然而还可以这样：

参数如下：

再或者继续折腾：

参数又成了这样：

或许还能更疯狂：

参数又成了：

这就是我做的“二叉分形树”。
代码如下：

Option Explicit
Public Sub FX_ecs()
Dim DD0(), DDi(), m&, n&, ni&, i&, j&, csjd0#(), csjdi#(), jd1#, jd2#, cd#, bl#, sz(), gd
ReDim csjd0#(1 To 3)
DD0 = Range("b2:c4").Value
csjd0(2) = Range("c5").Value
jd1 = Range("c6").Value
jd2 = Range("c7").Value
cd = Range("b9").Value
bl = Range("b10").Value
m = Range("b12").Value
sz = Range("b24:c36").Value
n = 0
Range("e2").Resize(20000, 26).ClearContents
Range("e2").Offset(, 2 * n).Resize(3 * 2 ^ n, 2).Value = DD0
Application.ScreenUpdating = False
gd = Split(sz(1, 2), ",")
Sht1.Unprotect
Sht1.ChartObjects("图表 3").Activate
With ActiveChart.FullSeriesCollection(1).Format.Line
.Weight = sz(1, 1)
.ForeColor.RGB = RGB(gd(0), gd(1), gd(2))
End With
Range("d1").Select
Application.ScreenUpdating = True
If Range("d20").Value = "是" Then GFTB: Sht1.Unprotect
Delay (Range("b13").Value)
For i = 1 To m
n = 2 ^ (i - 1)
ni = 3 * 2 ^ i
ReDim DDi(1 To ni, 1 To 2), csjdi#(1 To ni)
cd = cd * bl
For j = 1 To n
DDi(6 * (j - 1) + 1, 1) = DD0(3 * (j - 1) + 2, 1)
DDi(6 * (j - 1) + 1, 2) = DD0(3 * (j - 1) + 2, 2)
csjdi(6 * (j - 1) + 2) = csjd0(3 * (j - 1) + 2) + jd1
DDi(6 * (j - 1) + 2, 1) = DD0(3 * (j - 1) + 2, 1) + cd * Cos(csjdi(6 * (j - 1) + 2))
DDi(6 * (j - 1) + 2, 2) = DD0(3 * (j - 1) + 2, 2) + cd * Sin(csjdi(6 * (j - 1) + 2))
DDi(6 * (j - 1) + 4, 1) = DD0(3 * (j - 1) + 2, 1)
DDi(6 * (j - 1) + 4, 2) = DD0(3 * (j - 1) + 2, 2)
csjdi(6 * (j - 1) + 5) = csjd0(3 * (j - 1) + 2) - jd2
DDi(6 * (j - 1) + 5, 1) = DD0(3 * (j - 1) + 2, 1) + cd * Cos(csjdi(6 * (j - 1) + 5))
DDi(6 * (j - 1) + 5, 2) = DD0(3 * (j - 1) + 2, 2) + cd * Sin(csjdi(6 * (j - 1) + 5))
Next j
DD0 = DDi
csjd0 = csjdi
Range("e2").Offset(, 2 * i).Resize(3 * 2 ^ i, 2).Value = DDi
Application.ScreenUpdating = False
gd = Split(sz(i + 1, 2), ",")
Sht1.ChartObjects("图表 3").Activate
With ActiveChart.FullSeriesCollection(i + 1).Format.Line
.Weight = sz(i + 1, 1)
.ForeColor.RGB = RGB(gd(0), gd(1), gd(2))
End With
Range("d1").Select
Application.ScreenUpdating = True
If Range("d20").Value = "是" Then GFTB: Sht1.Unprotect
Delay (Range("b13").Value)
Next i
Sht1.Protect
End Sub
Public Sub GFTB()
Application.ScreenUpdating = False
Sht1.Unprotect
Sht1.ChartObjects("图表 3").Activate
With ActiveChart
.Axes(xlValue).MinimumScale = Range("c17").Value
.Axes(xlValue).MaximumScale = Range("d17").Value
.Axes(xlValue).MajorUnit = Range("b20").Value
.Axes(xlCategory).MinimumScale = Range("a17").Value
.Axes(xlCategory).MaximumScale = Range("b17").Value
.Axes(xlCategory).MajorUnit = Range("b20").Value
End With
Range("d1").Select
Sht1.Protect
Application.ScreenUpdating = True
End Sub
Public Sub Delay(T As Single) '延时
Dim time1!, time2!
time1 = Timer()
Do
DoEvents
time2 = Timer() - time1
If time2 < 0 Then time2 = time2 + 86400
Loop While time2 < T
End Sub

复制代码

附件如下：

二叉分形树.zip (854.48 KB, 下载次数: 81)

原理及附件中的其他特点，容后介绍。

aoe1981 · 发表于 2020-1-12 20:07

主楼附件其实还有一些作用，就是：关于VBA中56种颜色代码。

这个问题受以下两帖帮助：

1.
56种颜色和数字值对照表
http://club.excelhome.net/thread-927286-1-1.html
(出处: ExcelHome技术论坛)

2.
EXCEL VBA中的颜色代码
http://club.excelhome.net/thread-326227-1-1.html
(出处: ExcelHome技术论坛)

以下为帖2的18楼链接：
http://club.excelhome.net/forum. ... 227&pid=5095299

我改做成了下面的代码：

Option Explicit
Sub ColNum()
Dim i%, ColName_C(), ColName_E()
ColName_C = Array("黑色", "白色", "红色", "鲜绿色", "蓝色", "黄色", "粉红色", "青绿色", "深红色", "绿色", "深蓝色", "深黄色", "紫罗兰", "青色", "灰－25％", "灰－50％", "海螺色", "梅红色", "象牙色", "浅青绿", "深紫色", "珊瑚红", "海蓝色", "冰蓝", "深蓝色", "粉红色", "黄色", "青绿色", "紫罗兰", "深红色", "青色", "蓝色", "天蓝色", "浅青绿", "浅绿色", "浅黄色", "淡蓝色", "玫瑰红", "淡紫色", "茶色", "浅蓝色", "水绿色", "酸橙色", "金色", "浅橙色", "橙色", "蓝－灰", "灰－40％", "深青", "海绿", "深绿", "橄榄色", "褐色", "梅红色", "靛蓝", "灰－80％")
ColName_E = Array("Black", "White", "Red", "Bright Green", "Blue", "Yellow", "Pink", "Turquoise", "Dark Red", "Green", "Dark Blue", "Dark Yellow", "Violet", "Teal", "Gray-25%", "Gray-50%", "Periwinkle", "Plum+", "Ivory", "Lite Turquoise", "Dark Purple", "Coral", "Ocean Blue", "Ice Blue", "Dark Blue+", "Pink+", "Yellow+", "Turquoise+", "Violet+", "Dark Red+", "Teal+", "Blue+", "Sky Blue", "Light Turquoise", "Light Green", "Light Yellow", "Pale Blue", "Rose", "Lavender", "Tan", "Light Blue", "Aqua", "Lime", "Gold", "Light Orange", "Orange", "Blue-Gray", "Gray-40%", "Dark Teal", "Sea Green", "Dark Green", "Olive Green", "Brown", "Plum", "Indigo", "Gray-80%")
With Sht2
.Range("A1：D1").Value = Array("颜色显示", "颜色名", "数字值", "英文名")
For i = 1 To 56
.Cells(i + 1, 1).Interior.ColorIndex = i
.Cells(i + 1, 2) = ColName_C(i - 1)
.Cells(i + 1, 3) = i
.Cells(i + 1, 4) = ColName_E(i - 1)
Next i
End With
End Sub
Sub GetRGB()
Dim i&, C&, R&, G&, B&
With Sht2
.Range("e1").Value = "RGB值"
For i = 2 To 2000
If .Range("A" & i).Interior.ColorIndex = xlNone Then Exit For
C = .Range("A" & i).Interior.Color
R = C Mod 256
G = (C - R) / 256 Mod 256
B = (C - R - G * 256) / 256 ^ 2
.Cells(i, "E").Value = "'" & R & "," & G & "," & B
Next i
End With
End Sub

复制代码

做出的效果如下图：

这个有时候还是很有用的，在此，对上面两个帖子的作者表示敬意和感谢。

aoe1981 · 发表于 2020-1-12 20:28

本楼备注核心原理如下：

设有线段AB，其中：A为出发点，B为终止点。
令：
A(a,b)
B(c,d)
线段AB的初始角度为：csjd0
线段AB的长度为：cd
分枝递减比例为：bl

左杈角度：θ1
右杈角度：θ2
设：
左杈生长节点为：C(x1,y1)
右杈生长节点为：D(x2,y2)

则有：
（1）左杈生长节点：C(x1,y1)
x1=cd*bl*cos(csjd0+θ1)+c
y1=cd*bl*sin(csjd0+θ1)+d

（2）右杈生长节点：D(x2,y2)
x2=cd*bl*cos(csjd0-θ2)+c
y2=cd*bl*sin(csjd0-θ2)+d

然后反复迭代“生长节点”为新的线段“终止点”，并同时迭代记录各自分枝新的初始角度：csjdi。

基本数学知识如下图：

这些基础知识发挥了很大的作用。

aoe1981 · 发表于 2020-1-12 20:53

进一步胡乱折腾，出来了一个怪图，谁能想到这是“二叉分形树”！

图如下：

参数设置如下：

说不定，进一步折腾还有更多惊奇。

aoe1981 · 发表于 2020-1-12 22:02

再看看这一组：

够折腾。

lovemh1987 · 发表于 2020-1-13 09:20

aoe1981 发表于 2020-1-12 22:02
再看看这一组：

点赞点赞

静看流年RSSQ · 发表于 2020-1-13 09:32

后排膜拜大神。VBA 完全不懂。数学也不好。从来不及格。
点赞。

opel-wong · 发表于 2020-1-13 17:13

思路与数学的结合！
高手，佩服！膜拜！

aecn · 发表于 2020-1-13 17:21

高手，大神，非常牛叉的样子

FOB_FN_L · 发表于 2020-1-13 18:13

大佬这是开始画画了呀~~~

		自动登录	找回密码
密码			免费注册

[原创] 玩一玩简单的分形：二叉分形树

点评

评分

评分

评分

评分

评分

评分

最新热点 /1