t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

VBA クラスモジュールでタートルグラフィックプログラムを作成

今回はExcel VBAのクラスモジュールを使ってタートルグラフィックを描けるオブジェクトを作成してみた。

タートルグラフィックはカメを動かして線を引いていくプログラムで、プログラミング初心者の学習等で活用されることも多い。
例えばPythonでは標準装備されているのでモジュールをインポートするだけで使用できる。

以下がタートルを使ったグラフィックのイメージ。
f:id:t-hom:20210723124407p:plain

作成したVBAバージョンの使用イメージ。タートルといいつつカメは省略しているが、同じように線は引ける。
f:id:t-hom:20210723124756p:plain

入手方法

このプログラムはGitHubにアップロードしたので、使ってみたい方は以下より、binリンク→Turtle.xlsmリンク→Downloadボタンの順で入手可能である。
github.com

コードだけ見たい方はsrc/Turtle.xlsmリンクより、各モジュールのコードが確認できる。

作り方

今回は一応このブログにもコードを掲載しておこうと思う。

描画キャンバスの準備

Sheet1の表示メニューから枠線のチェックを外し、セルの線を非表示にしておく。
f:id:t-hom:20210723125641p:plain

次にSheet1のオブジェクト名をCanvasSheetに変更する。
※シートオブジェクト名の変更方法は以下の過去記事参照
thom.hateblo.jp

次に、VBEでCanvasSheetを開き、次のコードを張り付ける。

Sub Clear()
    Dim sh As Shape
    For Each sh In Me.Shapes
        sh.Delete
    Next
End Sub

Turtleクラスの作成

クラスモジュールを挿入し、オブジェクト名をTurtleとする。
次のコードを貼り付けて完成。

Option Explicit
Private isPenDown As Boolean
Private x As Double
Private y As Double
Private degree As Double

Sub Forward(length)
    Dim new_x As Double
    Dim new_y As Double
    new_x = x + Sin(Radian(degree)) * length
    new_y = y + Cos(Radian(degree)) * length
    If isPenDown Then
        Call CanvasSheet.Shapes.AddConnector(msoConnectorStraight, x, y, new_x, new_y)
    End If
    x = new_x
    y = new_y
End Sub

Sub PenDown()
    isPenDown = True
End Sub

Sub PenUP()
    isPenDown = False
End Sub

Sub TurnLeft(d)
    degree = degree + d
End Sub

Sub TurnRight(d)
    degree = degree - d
End Sub

Private Sub Class_Initialize()
    With CanvasSheet
        With Cells(.Rows.Count \ 2, .Columns.Count \ 2)
            x = .Left + Application.UsableWidth / 2
            y = .Top + Application.UsableHeight / 2
            Application.Goto .Item(1), True
        End With
    End With
    degree = 90
    CanvasSheet.Clear
End Sub

Function Radian(degree As Double) As Double
    Radian = degree / 45 * Atn(1)
End Function

Class_Initializeで少し特殊なことをしているが、これはExcel上で0,0よりも左上には描画できないためカメが早々に壁にぶつからないようにする対応策である。
シートの中央にジャンプさせてそこから描画を開始することでマイナス方向への移動の制約はほぼ無くなる。

メインモジュール

メインモジュールはクラスを使って好きにプログラムを書くだけである。
使える命令は以下のとおり。

命令 説明
PenDown ペンを下す命令。先にこれをしておかないと線が描けない。
PenUp ペンを上げる命令。線を書かずに場所を移動したいときにペンを上げる。
Forward(距離) 進行方向に進む命令。サイズ感が分からなければ、とりあえず100くらいから初めてみると良いと思われる。
TurnRight(角度) 進行方向を右に回転させる。
TurnLeft(角度) 進行方向を左に回転させる。

以下は、星型の図形を描くサンプル。

Sub Sample_Star()
    Dim t As Turtle: Set t = New Turtle
    
    t.PenDown
    Dim i As Integer
    For i = 1 To 5
        t.Forward 100
        t.TurnRight 360 / 5 * 2
    Next
End Sub

実行すると次のようになる。
f:id:t-hom:20210723131535p:plain

セルの左上がLCB524288となっているが、これはClass_Initializeで解説したように、A1付近から初めてしまうとマイナス方向への移動で早々に壁にぶつかってしまって描けなくなる為の対策である。

いろんなサイズの星をちりばめてみた。

Sub Sample_Star2()
    Dim t As Turtle: Set t = New Turtle
    
    For j = 1 To 50
        turn = WorksheetFunction.RandBetween(1, 360)
        fwd = WorksheetFunction.RandBetween(100, 300)
        size = WorksheetFunction.RandBetween(20, 100)
        t.TurnRight CDbl(turn)
        t.Forward CDbl(fwd)
        t.TurnLeft CDbl(turn)
        
        t.PenDown
        Dim i As Integer
        For i = 1 To 5
            t.Forward size
            t.TurnRight 360 / 5 * 2
        Next
        t.PenUP
    Next
End Sub

ランダムに移動しながら星をまき散らすので実行直後に数個しか表示されてなくても画面外にスクロールしていくと次のような星の群が見つかる。
f:id:t-hom:20210723133540p:plain

終わりに

プログラミング初心者の学習に使用されることが多いタートルプログラムだが、幾何学模様が手軽に作れるのでアイデア次第では面白いアート作品になると思う。
初心者向けの教材として使ってもらっても良いし、中~上級者はクラスを改造して色々と命令を追加してみるのも良いかなと思う。

今回作ったタートルは最低限の命令しか用意していないが、一般的には線の色を変えたり、バックしたり、角度・位置を直接指定したり、円を描いたりという命令が備わってるらしい。そういうコードを追加していっても良いかもしれない。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。