玩一玩简单的分形：科赫雪花

aoe1981

图如下：
迭代0次：


迭代1次：




迭代2次：




迭代3次：




迭代4次：




迭代5次：




迭代6次：




……

操作界面如下：



原理容后备注。


代码如下（全部公开）：

1. Option Explicit
   
2. Public Sub FX_xh()
   
3.     Dim DD0#(), DDi#(), m&, n&, ni&, i&, j&, jd#, jdd1#, jdd2#
   
4.     If Range("d19").Value <> "正确" Then MsgBox "参数不正确。": Range("d19").Select: End
   
5.     n = 3
   
6.     ReDim DD0#(1 To 4, 1 To 3)
   
7.     For i = 1 To 3
   
8.         DD0(i, 1) = i
   
9.         DD0(i, 2) = Cells(i + 1, 2).Value
   
10.         DD0(i, 3) = Cells(i + 1, 3).Value
    
11.     Next i
    
12.     DD0(4, 1) = 4
    
13.     DD0(4, 2) = Cells(2, 2).Value
    
14.     DD0(4, 3) = Cells(2, 3).Value
    
15.     jdd1 = Range("d17").Value
    
16.     jdd2 = Range("d18").Value
    
17.     jd = Range("c7").Value
    
18.     Range("f2").Resize(1000000, 3).ClearContents
    
19.     Range("d13:d14").Value = n
    
20.     Range("f2").Resize(n + 1, 3).Value = DD0
    
21.     If Range("d26").Value = "是" Then GFTB
    
22.     Delay (Range("b14").Value)
    
23.     m = Range("b13").Value
    
24.     For i = 1 To m
    
25.         ni = n + n * 3
    
26.         ReDim DDi#(1 To ni + 1, 1 To 3)
    
27.         For j = 1 To n
    
28.             DDi(4 * (j - 1) + 1, 1) = 4 * (j - 1) + 1 '端点1
    
29.             DDi(4 * (j - 1) + 1, 2) = DD0(j, 2)
    
30.             DDi(4 * (j - 1) + 1, 3) = DD0(j, 3)
    
31.             
    
32.             DDi(4 * (j - 1) + 2, 1) = 4 * (j - 1) + 2 '截断点1
    
33.             DDi(4 * (j - 1) + 2, 2) = DD0(j, 2) * (1 - jdd1) + DD0(j + 1, 2) * jdd1
    
34.             DDi(4 * (j - 1) + 2, 3) = DD0(j, 3) * (1 - jdd1) + DD0(j + 1, 3) * jdd1
    
35.             
    
36.             DDi(4 * (j - 1) + 4, 1) = 4 * (j - 1) + 4 '截断点2
    
37.             DDi(4 * (j - 1) + 4, 2) = DD0(j, 2) * (1 - jdd2) + DD0(j + 1, 2) * jdd2
    
38.             DDi(4 * (j - 1) + 4, 3) = DD0(j, 3) * (1 - jdd2) + DD0(j + 1, 3) * jdd2
    
39.             
    
40.             DDi(4 * (j - 1) + 3, 1) = 4 * (j - 1) + 3 '生成点1
    
41.             DDi(4 * (j - 1) + 3, 2) = Cos(jd) * (DDi(4 * (j - 1) + 4, 2) - DDi(4 * (j - 1) + 2, 2)) + Sin(jd) * (DDi(4 * (j - 1) + 4, 3) - DDi(4 * (j - 1) + 2, 3)) + DDi(4 * (j - 1) + 2, 2)
    
42.             DDi(4 * (j - 1) + 3, 3) = -Sin(jd) * (DDi(4 * (j - 1) + 4, 2) - DDi(4 * (j - 1) + 2, 2)) + Cos(jd) * (DDi(4 * (j - 1) + 4, 3) - DDi(4 * (j - 1) + 2, 3)) + DDi(4 * (j - 1) + 2, 3)
    
43.         Next j
    
44.         DDi(ni + 1, 1) = ni + 1
    
45.         DDi(ni + 1, 2) = DD0(1, 2)
    
46.         DDi(ni + 1, 3) = DD0(1, 3)
    
47.         Range("d13:d14").Value = ni
    
48.         Range("f2").Resize(ni + 1, 3).Value = DDi
    
49.         DD0 = DDi
    
50.         n = ni
    
51.         If Range("d26").Value = "是" Then GFTB
    
52.         Delay (Range("b14").Value)
    
53.     Next i
    
54. End Sub
    
55. Public Sub GFTB()
    
56.     Application.ScreenUpdating = False
    
57.     Sht.Unprotect
    
58.     Sht.ChartObjects("图表 3").Activate
    
59.     With ActiveChart
    
60.         .Axes(xlValue).MinimumScale = Range("c23").Value
    
61.         .Axes(xlValue).MaximumScale = Range("d23").Value
    
62.         .Axes(xlValue).MajorUnit = Range("b26").Value
    
63.         .Axes(xlCategory).MinimumScale = Range("a23").Value
    
64.         .Axes(xlCategory).MaximumScale = Range("b23").Value
    
65.         .Axes(xlCategory).MajorUnit = Range("b26").Value
    
66.     End With
    
67.     Range("e1").Select
    
68.     Sht.Protect
    
69.     Application.ScreenUpdating = True
    
70. End Sub
    
71. Public Sub Delay(T As Single) '延时
    
72.     Dim time1!, time2!
    
73.     time1 = Timer()
    
74.     Do
    
75.         DoEvents
    
76.         time2 = Timer() - time1
    
77.         If time2 < 0 Then time2 = time2 + 86400
    
78.     Loop While time2 < T
    
79. End Sub

复制代码

附件如下：

科赫雪花.zip (488.53 KB, 下载次数: 37)

2020-1-11 20:42 上传

点击文件名下载附件

本附件制作与前面三个相关帖的方法不一样，对于我而言：原创较多（当然，这些不是新东西，大神们早都司空见惯了，我却是独立首次），值得备注。

aoe1981

备注一下原理，免得以后看不懂了：

设有线段AB，其中：A为出发点，B为终止点。

令：

A(x1,y1)

B(x2,y2)

取截断点1：R(a,b)，截断比例：jdd1=1/3；

取截断点2：T(c,d)，截断比例：jdd2=2/3；

由截断点R、T得到生成点：S(x’,y’)，具体为：以R为圆心，将T点顺（逆）时针旋转θ角。

则有：

（1）截断点1：R(a,b)

（2）截断点2：T(c,d)

（3）生成点：S(x’,y’)

以上五个点的顺序是：A→R→S→T→B。

aoe1981

令：
jdd1=1/7
jdd2=4/7

则有：

迭代0次：



迭代1次：



迭代2次：



迭代3次：



迭代4次：



迭代5次：



迭代6次：











如果不厌其烦，进一步修改其他参数，或许还有更奇特的分形图形。

aoe1981

令：
旋转角度θ=150°，则有：

迭代0次：



迭代1次：



迭代2次：



迭代3次：



迭代4次：



迭代5次：



迭代6次：



迭代7次：











感觉有点像树杆。原来简单的规则，不断重复下去，竟然也会迸发出罕见的美感，奇哉怪也。