EXCEL（VBA）画树程序

最新推荐文章于 2024-09-15 12:49:10 发布

原创最新推荐文章于 2024-09-15 12:49:10 发布 · 1k 阅读

8 ·

CC 4.0 BY-SA版权

文章标签：

#vba #数据结构 #算法 #动态规划 #b树

看了好多Python写的画树，想看看在Excel里画个树行不行，于是乎花了点时间用VBA写了个，效果还不错，截个图给大家看看。

绿色固定配色版效果：

随机颜色版效果：

附上主代码

Sub test()
'画树主程序
'作者：孙建烽 42414074@qq.com
'需要定制软件可以加V ：yltxz001
'http://www.yltsoft.cn
Pi = 3.1415926
ClearSht_Shape Sheet3.Name
x = 600
y = 600
n = 11  '画树节点数
Sht_Line1 Sheet3.Name, x, y - 10, x, y + 50, 15, 0, 100, 0
drawTree x, y, n, Pi
End Sub

Sub drawTree(ByVal x As Single, ByVal y As Single, ByVal n As Integer, ByVal a As Double)
    Dim w As Single
    Dim g1 As Integer
    Pi = 3.1415926
    If n > 1 Then
        '分叉随机角度
        a1 = a + (Rnd() * Pi / 13 + Pi / 18)
        a2 = a - (Rnd() * Pi / 13 + Pi / 18)
        '分枝随机长度
        d1 = Rnd() * 50 + n * 4
        d2 = Rnd() * 50 + n * 4
        '分枝端点坐标
        x1 = x + Sin(a1) * d1
        y1 = y + Cos(a1) * d1
        x2 = x + Sin(a2) * d2
        y2 = y + Cos(a2) * d2
        w = n
        g1 = n
        Sht_Line1 Sheet3.Name, x, y, x1, y1, w, 0, 200 - g1 * 10, 0
        Sht_Line1 Sheet3.Name, x, y, x2, y2, w, 0, 200 - g1 * 10, 0
        n = n - 1
        drawTree x1, y1, n, a1
        drawTree x2, y2, n, a2
        '画花
        If n = 1 Then
            drawf Sheet3.Name, x1, y1
            drawf Sheet3.Name, x2, y2
        End If
    End If

End Sub

我的电脑配置老古董，画11个节点就有点卡了，不知道你们能画多少个节点。

需要源程序的可以到下面下载。

https://download.youkuaiyun.com/download/gc0322/22173412?spm=1001.2014.3001.5503