コードの実装と実行

コードの実装と実行

Visioによる計算尺の作成方針

前ページでは、Microsoft Office Visio 2007のVisual Basic for Applications(VBA)で線と文字を書く方法を紹介しました。ここでは実際に計算尺を作成するコードを作成して見たいと思います。

作成手順

新しい図面を作成する

前ページで紹介した方法と同じように、新しい図面を作成してください。

「スタート」→「すべてのプログラム」→「Microsoft Office」→「Microsoft Office Visio 2007」でMicrosoft Office Visioを起動します。

続いて「ファイル」メニュー→「新規作成」→「新しい図面」で新しい図面を作成することができます。

図面を横にする

Visioで新しい図面を作成した場合、縦長の図面になっていると思います。計算尺は横長ですので、あらかじめ図面を横向きにしておきたいと思います。

そこで、「ファイル」メニュー→「ページ設定」をクリックして、「ページ設定」ウィンドウを開きます。

「プリンタの設定」タブの「プリンタの用紙」の部分で、「横」を選択してください。

そして、「OK」ボタンをクリックすると図面の向きが横向きになります。

コードを入力する

それではコードを入力しましょう。

前ページでイラスト付きで紹介したのと同様、「ツール」メニュー→「マクロ」→「Visual Basic Editor」をクリックし、Visual Basic Editorを起動します。続いて、「This Document (図面1)」をダブルクリックするとコードを入力するウィンドウが表示されます。

そして、次のコードを入力します。

Visual Basic for Applications (VBA)
Sub MakeSlideRule()
    Dim vs As Shape
    Dim lineWeight As Double
    Dim longLength As Double
    Dim middleLength As Double
    Dim shortLength As Double
    Dim yLocation As Double
    Dim slideRuleHeight As Double
    slideRuleHeight = 0.7
    yLocation = 4
    longLength = 0.2
    middleLength = 0.1
    shortLength = 0.05
    lineWeight = 0.001
    Dim i As Integer
    Dim x As Double
    
    '枠線を引きます。
    Set vs = ActivePage.DrawLine(ValueToLocation(0.9), yLocation, ValueToLocation(11), yLocation)
    vs.Cells("LineWeight") = lineWeight
    Set vs = ActivePage.DrawLine(ValueToLocation(0.9), yLocation - slideRuleHeight, ValueToLocation(0.9), yLocation + slideRuleHeight)
    vs.Cells("LineWeight") = lineWeight
    Set vs = ActivePage.DrawLine(ValueToLocation(0.9), yLocation + slideRuleHeight, ValueToLocation(11), yLocation + slideRuleHeight)
    vs.Cells("LineWeight") = lineWeight
    Set vs = ActivePage.DrawLine(ValueToLocation(11), yLocation - slideRuleHeight, ValueToLocation(11), yLocation + slideRuleHeight)
    vs.Cells("LineWeight") = lineWeight
    Set vs = ActivePage.DrawLine(ValueToLocation(0.9), yLocation - slideRuleHeight, ValueToLocation(11), yLocation - slideRuleHeight)
    vs.Cells("LineWeight") = lineWeight
                    
    
    '1から2までの目盛線を引きます。
    For i = 0 To 100
        x = ValueToLocation(1 + i / 100)
        If i Mod 10 = 0 Then
            Set vs = ActivePage.DrawLine(x, yLocation - longLength, x, yLocation + longLength)
        ElseIf i Mod 5 = 0 Then
            Set vs = ActivePage.DrawLine(x, yLocation - middleLength, x, yLocation + middleLength)
        Else
            Set vs = ActivePage.DrawLine(x, yLocation - shortLength, x, yLocation + shortLength)
        End If
        vs.Cells("LineWeight") = lineWeight
    Next i
    
    '2.02から5までの目盛線を引きます。
    For i = 1 To 150
        x = ValueToLocation(2 + i / 50)
        If i Mod 25 = 0 Then
            Set vs = ActivePage.DrawLine(x, yLocation - longLength, x, yLocation + longLength)
        ElseIf i Mod 5 = 0 Then
            Set vs = ActivePage.DrawLine(x, yLocation - middleLength, x, yLocation + middleLength)
        Else
            Set vs = ActivePage.DrawLine(x, yLocation - shortLength, x, yLocation + shortLength)
        End If
        vs.Cells("LineWeight") = lineWeight
    Next i
    
    '5.05から10までの目盛線を引きます。
    For i = 1 To 100
        x = ValueToLocation(5 + i / 20)
        If i Mod 10 = 0 Then
            Set vs = ActivePage.DrawLine(x, yLocation - longLength, x, yLocation + longLength)
        ElseIf i Mod 2 = 0 Then
            Set vs = ActivePage.DrawLine(x, yLocation - middleLength, x, yLocation + middleLength)
        Else
            Set vs = ActivePage.DrawLine(x, yLocation - shortLength, x, yLocation + shortLength)
        End If
        vs.Cells("LineWeight") = lineWeight
    Next i
    
    '1から10までの数字を書きます。
    For i = 1 To 10
        x = ValueToLocation(CDbl(i))
        Set vs = ActivePage.DrawRectangle(x - 0.2, yLocation - longLength - 0.2, x + 0.2, yLocation - longLength)
        vs.Text = CStr(i)
        vs.LineStyle = "Text Only"
        vs.FillStyle = "Text Only"
        vs.Cells("Char.size").Result("pt") = 12
        
        Set vs = ActivePage.DrawRectangle(x - 0.2, yLocation + longLength + 0.2, x + 0.2, yLocation + longLength)
        vs.Text = CStr(i)
        vs.LineStyle = "Text Only"
        vs.FillStyle = "Text Only"
        vs.Cells("Char.size").Result("pt") = 12
    Next i
    
    '尺名を書きます。
    x = ValueToLocation(CDbl(0.95))
    Set vs = ActivePage.DrawRectangle(x - 0.2, yLocation - longLength - 0.15, x + 0.2, yLocation - longLength + 0.05)
    vs.Text = "D"
    vs.LineStyle = "Text Only"
    vs.FillStyle = "Text Only"
    vs.Cells("Char.size").Result("pt") = 20
    
    x = ValueToLocation(CDbl(0.95))
    Set vs = ActivePage.DrawRectangle(x - 0.2, yLocation + longLength - 0.1, x + 0.2, yLocation + longLength + 0.1)
    vs.Text = "C"
    vs.LineStyle = "Text Only"
    vs.FillStyle = "Text Only"
    vs.Cells("Char.size").Result("pt") = 20
    
    'タイトルを書きます。
    x = ValueToLocation(CDbl(1.2))
    Set vs = ActivePage.DrawRectangle(x - 1.5, yLocation + slideRuleHeight, x + 1.5, yLocation + slideRuleHeight + 0.5)
    vs.Text = "基本計算尺"
    vs.LineStyle = "Text Only"
    vs.FillStyle = "Text Only"
    vs.Cells("Char.size").Result("pt") = 30
    
    x = ValueToLocation(CDbl(6))
    Set vs = ActivePage.DrawRectangle(x - 3, yLocation - slideRuleHeight - 0.1, x + 3, yLocation - slideRuleHeight + 0.4)
    vs.Text = "計算尺推進委員会 http://www.pi-sliderule.net/"
    vs.LineStyle = "Text Only"
    vs.FillStyle = "Text Only"
    vs.Cells("Char.size").Result("pt") = 18
End Sub

Static Function Log10(x) As Double
    Log10 = Log(x) / Log(10)
End Function

'1<=x<=10の引数に対して、線を表示する位置をインチ単位で返します。
Static Function ValueToLocation(x As Double) As Double
    ValueToLocation = Log10(x) * 25 / 2.54 + 1
End Function

さてこれで作成の準備が整いました。

実行

それでは、元のVisioのウィンドウで、「ツール」メニュー→「マクロ」→「This Document」→「MakeSlideRule」とクリックしてください。

すると、次のように計算尺の図面が作成されます。

これでVisio のVBAから計算尺の図面を作成することができました。

完成したファイル

今回作成したファイルを掲載しておきます。

考察と発展

Visioを利用して計算尺を作成する方法の利点は、やはり精度よく図面を作成できるということでしょう。計算尺作成プログラムの作成では今回紹介したのとほぼ同じ作業を行いましたが、画像のサイズが決まってしまうためにピクセル以上の精度を出すことができませんでした。それに対してVisioではビットマップ形式の図面を作成するのではなくベクトル形式で作成するため、より高い精度で作成することができます。

今回は計算尺の中で最も基本的なC尺とD尺のみを作成しました。今回紹介した方法を応用すれば、さらにほかの尺も簡単に作成することができます。