読者です 読者をやめる 読者になる 読者になる

I'm curious about... -コレが気になる-

技術系サラリーマンの生活実験

【自転車実験室】スポークパターン検討用のテンプレートをExcelで作る

ホイールのスポークパターンを考える時、実際に絵を描いています。アマチュアですし、組んだ本数も少ないので頭で迷わず組めるほど習熟していません。

 

でも、手描きで描けるほど絵心もないので、Excelで描いています。オートシェイプを線で結ぶ時、線がオートシェイプに吸着してくれるので、スポーク代わりの線が引きやすいのです。

最初に描いた時の32hのパターンはセコセコ手でオートシェイプを配置しましたが、リムやハブの穴みたいに円周上に均等にオートシェイプを配置するのは正直面倒でした。

 

なので、自動で配置する事にしました。

下のスクリーンショットがその画面です。

 

f:id:tkcx3110:20170119232955p:plain

 

左上のセル「B2」と「B3」に穴数を入力して、「Make Hole」ボタンを押すと、円周上にオートシェイプが配置されます。「Clear」ボタンを押すとオートシェイプが消えます。

 

 力技で組んだExcel VBAプログラムのソースは以下の通りです。

 

Option Explicit

Sub MakeHole()

'入力された穴数にあわせて、スポークパターン検討用のテンプレートを出力する

    Dim RimHole As Integer  'リム穴数格納用

    Dim HubHole As Integer  'ハブ穴数格納用

    Dim Count As Integer    'カウンタ用

    Dim HoleX As Variant    'オートシェイプのX座標

    Dim HoleY As Variant    'オートシェイプのY座標

    Dim Angle As Variant    '穴の角度

    Dim ShapeName As String '穴の名前

 

    '穴数の格納

    RimHole = ActiveSheet.Cells(2, 2).Value

    HubHole = ActiveSheet.Cells(3, 2).Value

 

    'リム穴の配置

    For Count = 1 To RimHole

 

        '三角関数で円周上の座標を計算する

        '角度を求める

        Angle = (360 / RimHole * (Count - 1)) + (180 / RimHole)

 

        '穴の名前を作る

        ShapeName = "RimHole" & Count

 

        'X座標を求める

        HoleX = Cos(WorksheetFunction.Radians(Angle)) * 275 + 320

        'Y座標を求める

        HoleY = Sin(WorksheetFunction.Radians(Angle)) * 275 + 300

 

        '穴を作る

        With ActiveSheet.Shapes

            .AddShape(msoShapeOval, HoleX, HoleY, 3.5, 3.5).Name = ShapeName

            .Range(Array(ShapeName)).ShapeStyle = msoShapeStylePreset14

        End With

 

    Next Count

 

    'ハブ穴の配置

    For Count = 1 To HubHole

 

        '三角関数で円周上の座標を計算する

        '角度を求める

        Angle = (360 / HubHole * (Count - 1))

 

      '穴の名前を作る

        ShapeName = "HubHole" & Count

       

  '偶数、奇数で場合分け

        If WorksheetFunction.IsOdd(Count) = True Then

       

      'X座標を求める

            HoleX = Cos(WorksheetFunction.Radians(Angle)) * 50 + 320

            'Y座標を求める

            HoleY = Sin(WorksheetFunction.Radians(Angle)) * 50 + 300

       

      '穴を作る

            With ActiveSheet.Shapes

                .AddShape(msoShapeOval, HoleX, HoleY, 3.5, 3.5).Name = ShapeName

                .Range(Array(ShapeName)).ShapeStyle = msoShapeStylePreset10

            End With

       

  Else

       

      'X座標を求める

            HoleX = Cos(WorksheetFunction.Radians(Angle)) * 50 + 320

            'Y座標を求める

            HoleY = Sin(WorksheetFunction.Radians(Angle)) * 50 + 300

       

      '穴を作る

            ActiveSheet.Shapes.AddShape(msoShapeOval, HoleX, HoleY, 3.5, 3.5).Name = ShapeName

       

  End If

   

 Next Count

 

End Sub

 

本職の人からしたら 「なんじゃこれ」と思われるコーディングかも知れませんが、動くからいいのです。他になんの役にも立たないので。

 

自宅で使っているMac版のExcelには、オートシェイプをまとめて選択する機能がないので、「Clear」ボタンには以下のコードを設定してオートシェイプをまとめて消せるようにしました。ボタンにはそれぞれ「Make」と「Clear」の名前を付けておく必要があります。

 

'穴を消す

Sub ClearHole()

   

 Dim Hole As Shape

   

 For Each Hole In ActiveSheet.Shapes

   

     '穴を作るボタンと消すボタン以外のオートシェイプを削除

        If Hole.Name = "Make" Then

            'Do Nothing

        ElseIf Hole.Name = "Clear" Then

            'Do Nothing

        Else

            Hole.Delete

        End If

   

 Next Hole

 

End Sub

 

CADを使えよ、と言う話かもしれませんが、ExcelVBAのプログラムはExcelがインストールされているPCならどこでも使えるので、特別な環境を用意しなくてもでデータ処理等が手早く解決する場合が多く、普段の仕事でも重宝しています。

私はプロのプログラマではないので、プログラム自体を納品することがないから自由に組めることも魅力です。

 

くだらない目的のためにツールを作るのって、「遊び」があって私は大好きです。