ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 228|回复: 3

[原创] 玩一玩简单的分形:科赫雪花

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-1-11 19:20 | 显示全部楼层 |阅读模式
本帖最后由 aoe1981 于 2020-1-11 20:43 编辑

图如下:
迭代0次:
0.jpg

迭代1次:

1.jpg


迭代2次:

2.jpg


迭代3次:

3.jpg


迭代4次:

4.jpg


迭代5次:

5.jpg


迭代6次:

6.jpg


……

操作界面如下:

a.jpg

原理容后备注。


代码如下(全部公开):

  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, 下载次数: 12)

评分

参与人数 3鲜花 +6 收起 理由
Datous + 2
ardu95 + 2
FOB_FN_L + 2 值得肯定

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-11 21:18 | 显示全部楼层
备注一下原理,免得以后看不懂了:

设有线段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)

s1.jpg

(2)截断点2:T(c,d)

s2.jpg

(3)生成点:S(x’,y’)

s3.jpg

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-11 21:33 | 显示全部楼层
令:
jdd1=1/7
jdd2=4/7

则有:

迭代0次:

10.jpg

迭代1次:

11.jpg

迭代2次:

12.jpg

迭代3次:

13.jpg

迭代4次:

14.jpg

迭代5次:

15.jpg

迭代6次:

16.jpg









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

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-11 21:53 | 显示全部楼层
令:
旋转角度θ=150°,则有:

迭代0次:

20.jpg

迭代1次:

21.jpg

迭代2次:

22.jpg

迭代3次:

23.jpg

迭代4次:

24.jpg

迭代5次:

25.jpg

迭代6次:

26.jpg

迭代7次:

27.jpg









感觉有点像树杆。原来简单的规则,不断重复下去,竟然也会迸发出罕见的美感,奇哉怪也。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2020-4-4 20:57 , Processed in 0.105042 second(s), 19 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表