ポリラインで囲われたエリアの面積を測定するマクロ｜AutoCAD VBAマクロの作成方法
今回のサンプルマクロはポリラインで囲われたすべてのエリアの面積を測定するマクロです。ポリラインが複数ある場合、どのポリラインがどの面積なのかを一目でわかるようにポリラインの中心部分にテキストとして出力する仕様となっています。
マクロ機能
・測定結果はポリラインの中心位置にダイナミックテキストとして出力する
・開いてるポリライン、自己交差しているポリライン、ブロック内のポリラインは対象外
面積を取得するだけであれば(LW)PolylineのAreaプロパティにアクセスするだけで簡単に取得できますが、本マクロでは測定結果のテキストをポリラインの中央に配置するような処理を実装しています。
サンプルコード
マクロのサンプルコードは下記のとおりです。事前にアクティブドキュメントのモデル空間に閉じたポリラインを作成しておく必要があります。測定結果を表示するテキストのサイズは定数のため、ポリラインのサイズによっては小さすぎたり大きすぎたりする可能性があります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 |
Option Explicit Sub main() Dim mdlSpace As AcadModelSpace Dim oEntity As AcadEntity Dim oPoly As AcadLWPolyline Dim vCrvs(0) As AcadEntity Dim vRegions As Variant Dim oRegion As AcadRegion Dim vCoordCog As Variant Dim oTxt As AcadText 'ﾓﾃﾞﾙ空間取得 Set mdlSpace = ThisDrawing.ModelSpace 'ﾓﾃﾞﾙ空間要素ﾙｰﾌﾟ For Each oEntity In mdlSpace 'ﾎﾟﾘﾗｲﾝの場合のみ測定対象 If TypeName(oEntity) = "IAcadLWPolyline" Then 'ﾎﾟﾘﾗｲﾝを配列に格納 Set oPoly = oEntity Set vCrvs(0) = oPoly 'ﾎﾟﾘﾗｲﾝからﾘｰｼﾞｮﾝ作成 On Error Resume Next vRegions = Empty Set oRegion = Nothing vRegions = mdlSpace.AddRegion(vCrvs) Set oRegion = vRegions(0) On Error GoTo 0 'ﾘｰｼﾞｮﾝ作成に成功したﾎﾟﾘﾗｲﾝのみ測定対象 If Not oRegion Is Nothing Then 'ﾘｰｼﾞｮﾝの中心点座標を取得 vCoordCog = oRegion.Centroid ReDim Preserve vCoordCog(2) '空のﾃｷｽﾄを追加して位置合わせを[中央(MC)]に設定 Set oTxt = mdlSpace.AddText("", vCoordCog, 5) oTxt.Alignment = acAlignmentMiddleCenter oTxt.TextAlignmentPoint = vCoordCog 'ﾃｷｽﾄの文字列にﾎﾟﾘﾗｲﾝの面積を設定 oTxt.TextString = "Area: " & Format(oPoly.Area, "0.000") 'ﾘｰｼﾞｮﾝ削除 Call oRegion.Delete End If End If Next '描画更新 ThisDrawing.Regen acAllViewports End Sub |
コード解説
モデル空間内のポリラインループ処理
モデル空間を操作するためのModelSpaceはコレクションであるため、コレクション内ループを行うことでモデル空間内の全要素を取得することができます。このとき取得したオブジェクトのタイプを判定することで、ポリラインのみに対して特定の処理を行うことができるようになります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
'ﾓﾃﾞﾙ空間取得 Set mdlSpace = ThisDrawing.ModelSpace 'ﾓﾃﾞﾙ空間要素ﾙｰﾌﾟ For Each oEntity In mdlSpace 'ﾎﾟﾘﾗｲﾝの場合のみ測定対象 If TypeName(oEntity) = "IAcadLWPolyline" Then 'If oEntity.ObjectName = "AcDbPolyline" Then こちらでも可 '※ﾎﾟﾘﾗｲﾝに対する処理 End If Next |
サンプルコードでは上記の通りTypeName関数を使って要素がポリラインであるかを判定していますが、別の方法として「ObjectNameプロパティ」を調べるという手法もあります。
AutoCAD VBAのポリラインには「Polylineオブジェクト」と「LWPolylineオブジェクト」の2種類のオブジェクトが存在しますが、ヘルプページにも記載されているとおりPolylineは旧バージョンのオブジェクトでLWPolylineが新バージョンのオブジェクトです。LWPolylineが登場するより以前に作られたマクロでも動作するように旧バージョンも残されているだけであり、LWPolylineオブジェクトが利用できる環境であればそちらを使うことが推奨されます。(※LW=Light Weight)
このオブジェクトは LightweightPolyline オブジェクトの旧バージョンです。
このメソッドは、以前のバージョンとの後方互換用です。LightweightPolyline オブジェクトを使用すれば、メモリやディスク容量を節約できる最適化形式のポリラインを作成することができます。
AutoDesk公式ヘルプ「Polyline オブジェクト(ActiveX)」より
ポリラインからリージョン作成して中心座標を取得
このマクロは最終的に測定した面積をダイナミックテキストとしてポリラインの中心に出力するため、ポリラインの中心座標を取得する必要があります。ここではリージョン(Regionオブジェクト)が持つCentroidプロパティを利用するため、ポリラインを入力としてリージョンの作成を行います。
リージョンの作成はModelSpaceオブジェクトのAddRegionメソッドで作成可能です。引数に入力するのはリージョンを作成するために必要な囲われたエリアを定義するための線分やポリライン、円弧などの2D曲線要素が入ったVariant型配列です。サンプルコードでは閉じたポリラインを対象としているため、入力としてはポリライン1つのみです。そのため要素数が1つのVariant型配列を作成して、その中にポリラインを1つ入れたものをAddRegionメソッドの引数として入力しています。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
'ﾎﾟﾘﾗｲﾝを配列に格納 Set oPoly = oEntity Set vCrvs(0) = oPoly 'AddRegionﾒｿｯﾄﾞ用に配列化 'ﾎﾟﾘﾗｲﾝからﾘｰｼﾞｮﾝ作成 On Error Resume Next vRegions = Empty '配列初期化 Set oRegion = Nothing '変数初期化 vRegions = mdlSpace.AddRegion(vCrvs) 'ﾘｰｼﾞｮﾝ作成 Set oRegion = vRegions(0) '作成したﾘｰｼﾞｮﾝ取得 On Error GoTo 0 |
AddRegionメソッドは複数の2D曲線要素が入力されリージョンが複数作成できた場合のことも考慮されており、戻り値は配列となっています。サンプルコードでは1つのポリラインしか入力していないため1つのリージョンしか作成されないですが、1度配列として結果を受け取る必要があります。その後、配列の初めの要素にアクセスすることで作成したRegionオブジェクトを取得することができます。
このとき、閉じていないポリラインや自己交差しているポリライン等が入力されリージョンの作成自体ができないことを考慮して「On Error Resume Next」でエラーを無視させています。このときエラーが出て失敗したときに1つ前のループの結果が残っていないように変数および配列内を初期化しています。これにより作成したリージョン(oRegion)がNothingであるかの確認をするだけで正常に作成できたか否かの判定が可能になります。
|
1 2 3 4 5 6 7 8 9 10 |
'ﾘｰｼﾞｮﾝ作成に成功したﾎﾟﾘﾗｲﾝのみ測定対象 If Not oRegion Is Nothing Then 'ﾘｰｼﾞｮﾝの中心点座標を取得 vCoordCog = oRegion.Centroid ReDim Preserve vCoordCog(2) End If |
リージョンの作成ができたらCentroidプロパティで中心座標を取得します。Centroidプロパティで取得できる中心座標はX座標とY座標の2つの値が入った配列ですが、この後の処理でテキストを作成する際にZ座標を含めた3要素数分の配列が必要になるため「ReDim Preserve」を使って、現在の値はそのままで配列の要素数を1つ増やしています。
面積をポリラインの中心位置にテキスト出力
リージョンの中心座標地点にダイナミックテキストを出力します。ダイナミックテキストの作成はModelSpaceオブジェクトのAddTextメソッドで作成可能です。引数としては「値, 作成位置(配列), テキスト高さ」の3つの情報が必要になります。サンプルコードではテキスト文字列は後ほど設定するため第1引数は一旦空文字(“”)で作成していますが、ここに直接ポリラインの面積を入力しても問題ありません。第2引数にはリージョンの中心座標、第3引数は適当な定数値として”5″を入力しています。
|
1 2 3 4 5 6 7 8 9 |
'空のﾃｷｽﾄを追加して位置合わせを[中央(MC)]に設定 Set oTxt = mdlSpace.AddText("", vCoordCog, 5) oTxt.Alignment = acAlignmentMiddleCenter oTxt.TextAlignmentPoint = vCoordCog 'ﾃｷｽﾄの文字列にﾎﾟﾘﾗｲﾝの面積を設定 oTxt.TextString = "Area: " & Format(oPoly.Area, "0.000") |
作成したテキストはデフォルト設定では位置合わせが[左寄せ]になっているため、[中央]に変更しています。Alignmentプロパティで定数値「acAlignmentMiddleCenter」を入力すれば[中央]に変更されますが、このプロパティだけの変更だとテキストの位置が原点に移動してしまいます。Alignmentプロパティの変更とあわせてTextAlignmentPointプロパティに指定の座標位置(配列)を入力すれば勝手に原点に移動する問題は起こらなくなります。(※Alignment変更→TextAlignmentPoint変更の順)
あとはTextStringプロパティにテキストに入力する文字列を設定するだけです。ポリラインの面積はAreaプロパティで取得可能です。小数点以下がかなり細かい数値まで取得できるので、サンプルコードではFormat関数を使って小数点以下第３位まで表示するようにしています。
まとめ
今回のマクロの核となるのは「面積の取得」と「中心座標の取得」の2点です。面積取得だけであればAreaプロパティを使えばすぐに取得可能です。中心座標はリージョンを利用して取得しましたが、そのほかの方法としてGetBoundingBoxメソッドを使ってポリラインのバウンディングボックスを作成し、そのバウンディングボックスの頂点座標から中心点座標を計算で求めるという方法もあります。
関連書籍
