category name  »  page title date

地図にドットを打つ

たとえば、下のような図。これはある都市の町丁目の境界線を引いた中に、それぞれの町丁目の建築確認申請件数をドットの数で表示したものです。
こんな感じの図がほしいことがよくあります。市町村別の人口とか、コンビニの軒数とか、いろいろなものがありそうですね。表をにらんでいてもわからないけど、こういう風に図にしてみると全体の傾向や構造が見えてくることがよくあります。
しかし、これを手で書くのは大変です。

そこで、これをイラストレーターで簡単に描けるように、工夫してみました。
もっと賢い方法があるかもしれませんが、けっこう素直な手順で作ったので、コード自体は少し長くなりました。しかし、上の程度のスケールであれば、あっという間に描画が終了します。

イラストレーターのレイヤー構成は、こうしています。
"legend"となっているのは凡例で、ここに"rectangle"と"circle"というパスがはいっていますが、これは描くべきドットの模様です。"boundary"というレイヤーには、境界線のパスがはいっていて、それぞれ町の名前をつけてあります。
町の名前と凡例の種類、それに描くべきドットの数を指定して、一番上の"marks"というレイヤーにドットを描かせる、というわけです。"marks"レイヤーは、なければ新たに作られます。
以上の３つのレイヤー以外のレイヤーはこの操作に影響しません。
ここで使うパスは、凡例も境界線も任意のパス（複合パスやグループ、テキストなどを含む）をいくらでも追加できます。

これらのレイヤーの名前は、次の標準モジュールの先頭に Const で定義してあります。必要ならここを変更すればカスタマイズできます。


DrawMark() がこの仕事を行う本体です。
イラストレーターで legend と boundary のレイヤーに必要なパスを作成したファイルを用意しておきます。 次に、境界線のパスの名前と凡例のパスの名前、マークの数を引数として DrawMark() を呼ぶと、境界線で囲まれた範囲の中央部に、ほぼ正方形の領域に整列した所定の個数のマークが描かれます。マークは、指定した凡例マークのパスをコピーして設置します。描かれたマークは、"marks"レイヤー内に境界線ごとにグループ化されてはいります。

このマクロを呼ぶ前に、対象となるイラストレーター・ドキュメント AiDoc を取得しておく必要がありますが、ここでは「イラストレーターを開く」で作成した SelectAiFile() を使いました。これを Public AiDoc という宣言とともに、どこかの標準モジュールにいれておきましょう。

DrawMark() の使い方は、DrawMarksDemo() をご覧ください。ここでは、それぞれの引数を直接列挙していますが、実際はどこかのワークシート上に作成された表を For～Next などのループで読み込んで DrawMark() に渡すことになるはずです。

DrawMark() は、コピーした凡例マークを設置するアドレスを計算するために PlaceBoxRectangle() と GetMarkPosition() を呼んでいますが、いっしょのモジュールに入れると煩雑なので、別のモジュールにいれました。

標準モジュール     DrawMark()

'意味を持つレイヤーの名称
Private Const areaLayerName = "boundary"
Private Const legendLayerName = "legend"
Private Const marksLayerName = "marks"
'マークを描く際の隣同士の間隔
Private Const markGap = 4

Private areaPath
Private legendPath

'----- DrawMark() の使い方
Public Sub DrawMarksDemo()
    'イラストレータファイルを選択して、ドキュメントを取得
    If Not SelectAiFile Then Exit Sub
    'それぞれのエリア内に指定のマークを指定個数描いていく
    DrawMark "昭和町", "circle", 25
    DrawMark "平成町", "rectangle", 10
    DrawMark "令和町", "star", 5
End Sub
'----- 指定個数のマークを所定の場所に描く
Public Function DrawMark(areaName, legendName, count) As Boolean
Dim newGroup, newMark, index
      If count <= 0 Then Exit Function
      If Not getPath(areaName, legendName) Then Exit Function
      legendPath.Locked = False
      Set newGroup = getMarksLayer.GroupItems.Add
      PlaceBoxRectangle areaPath, legendPath, count, markGap
      '指定の凡例マークをコピーして、所定の位置に移動しグループに追加する
      For index = 1 To count
            Set newMark = legendPath.Duplicate
            newMark.left = GetMarkPosition(index).X
            newMark.top = GetMarkPosition(index).Y
            newMark.moveToBeginning newGroup
      Next
      DrawMark = True
End Function
'----- パスを検索
Private Function getPath(areaName, legendName) As Boolean
      On Error Resume Next
      Set areaPath = AiDoc.Layers(areaLayerName).PageItems(areaName)
      If Err.Number <> 0 Then notExistName areaLayerName, areaName: Exit Function
      Set legendPath = AiDoc.Layers(legendLayerName).PageItems(legendName)
      If Err.Number <> 0 Then notExistName legendLayerName, legendName: Exit Function
      getPath = True
End Function
'----- パスが見つからなかった名前を列挙・保存
Private Sub notExistName(layer, name)
      MsgBox _
        "レイヤー [ " & layer & " ] の中に" & vbCrLf & _
        "[ " & name & " ] というパスが/ありません。", _
        vbOKOnly, ""
End Sub
'----- "marks"レイヤーを取得　（なければ新たに作成）
Private Function getMarksLayer() As Object
      On Error Resume Next
      Set getMarksLayer = AiDoc.Layers(marksLayerName)
      If Err.Number <> 0 Then
            Set getMarksLayer = AiDoc.Layers.Add
            getMarksLayer.name = marksLayerName
      End If
End Function


マークの描画アドレスの計算は、次の標準モジュールで行っています。 まず、PlaceBoxRectangle() で描画個数 marksCount に対応した正方形の描画エリアの大きさを計算したうえで、それを親ポリゴンである境界線パスの中央部に配置するよう、boxPosition を決めます。 こうしておいて、GetMarkPosition(index) を呼ぶと、そこに描かれるべき index 番目のマークの描画アドレスが取得される、というわけです。

標準モジュール      PlaceBoxRectangle(), GetMarkPosition()

'Positionオブジェクトの宣言
Public Type Position
    X As Double
    Y As Double
End Type
'親ポリゴンのパス、凡例マークのパス
Private areaPath, markPath
'描画するマークの個数
Private marksCount As Long
'マーク描画エリアの位置
Private boxPosition As Position
'描画するマークの行・列数
Private columnsCount As Long
Private rowsCount As Long
'隣接するマークの間隔
Private markGap As Long

'----- 描画エリアの位置、マークの行・列数を計算しておく
Public Sub PlaceBoxRectangle(areaPathItem, markPathItem, count, mGap)
      Set areaPath = areaPathItem
      Set markPath = markPathItem
      marksCount = count
      markGap = mGap
      calculateBoxSize
End Sub
'----- index 番目のマークを描画する位置
Public Function GetMarkPosition(index) As Position
Dim row, column
      row = (index - 1) \ columnsCount
      column = (index - 1) Mod columnsCount
      GetMarkPosition.X = boxPosition.X + (markPath.width + markGap) * column
      GetMarkPosition.Y = boxPosition.Y - (markPath.height + markGap) * row
End Function
'----- マーク描画エリアの位置と大きさ、描画するマークの行・列数の計算
Private Sub calculateBoxSize()
Dim boxWidth As Double
Dim boxHeight As Double
      columnsCount = WorksheetFunction.RoundUp(marksCount ^ (1 / 2), 0)
      rowsCount = WorksheetFunction.RoundUp(marksCount / columnsCount, 0)
      boxWidth = (markPath.width + markGap) * columnsCount - markGap
      boxHeight = (markPath.height + markGap) * rowsCount - markGap
      With areaPath
            boxPosition.X = .left + .width / 2 - boxWidth / 2
            boxPosition.Y = .top - .height / 2 + boxHeight / 2
      End With
End Sub