2Dリージョンのマスプロパティを取得するマクロ|AutoCAD VBAマクロの作成方法

AutoCADでは[MASSPROP]コマンドを実行することで、リージョンのマスプロパティ(面積、慣性モーメント、図心、回転半径など)を取得することができますが、これらの情報はVBAでも取得可能です。

VBAを使用してマスプロパティの情報を取得することで、その情報を処理の一連の流れに組み込むことができます。これにより、たとえば、取得したマスプロパティの情報を表として出力したり、複数のリージョンからマスプロパティを一括で取得したりすることが可能になります。
 

マクロ機能

 icon-wrench マクロの機能まとめ  ・モデル空間に存在するユーザーが選択したリージョンのマスプロパティ※1を取得する
   (※1 面積, 周囲, 境界ボックス, 図心座標, 慣性モーメント, 慣性乗積, 回転半径, 主慣性モーメント)
・取得したマスプロパティ情報はイミディエイトウィンドウに出力する
・取得したマスプロパティ情報から主軸を作図する

イミディエイトウィンドウへの出力は[MASSPROP]コマンドの出力結果に合わせていますが、取得できる値は各項目の値です。VBAではかなり細かい値まで取得することができるため、小数点以下第何位で丸めたいという場合はFormat関数Round関数などを使う必要があります。
 

サンプルコード

マクロのサンプルコードは下記のとおりです。事前にアクティブドキュメントのモデル空間にリージョンを作成しておく必要があります。マクロ実行後、ユーザーの選択待ち状態となるので対象のリージョンを選択することでマスプロパティを取得することができます。

Option Explicit
'********************************************************************
'*  リージョンのマスプロパティを取得する
'********************************************************************
Sub GetRegionMassProperty()

    Dim oRegion As AcadRegion
    Dim oEntity As AcadEntity
    Dim dArea As Double
    Dim dPerimeter As Double
    Dim vCog As Variant
    Dim vBBMin As Variant
    Dim vBBMax As Variant
    Dim vMoI As Variant
    Dim vPoI As Variant
    Dim vRoG As Variant
    Dim vPMoments As Variant
    Dim vPDirs As Variant
    
    'ユーザー選択でリージョン取得
    On Error Resume Next
    Call ThisDrawing.Utility.GetEntity(oEntity, Empty, "リージョンを選択")
    On Error GoTo 0
    If TypeName(oEntity) <> "IAcadRegion" Then Exit Sub
    Set oRegion = oEntity
    
    '//----- マスプロパティの取得 -----//
    dArea = oRegion.Area                        '<面積>
    dPerimeter = oRegion.perimeter              '<周囲>
    Call oRegion.GetBoundingBox(vBBMin, vBBMax) '<境界ボックス>
    vCog = oRegion.Centroid                     '<図心座標>
    vMoI = oRegion.momentOfInertia              '<慣性モーメント>
    vPoI = oRegion.ProductOfInertia             '<慣性乗積>
    vRoG = oRegion.RadiiOfGyration              '<回転半径>
    vPMoments = oRegion.PrincipalMoments        '<主慣性モーメント>
    vPDirs = oRegion.PrincipalDirections        '<主方向>
    
    'マスプロパティをイミディエイトウィンドウに出力
    Debug.Print "----------------    リージョン    ----------------"
    Debug.Print "面積:              " & dArea
    Debug.Print "周囲:              " & dPerimeter
    Debug.Print "境界ボックス:   X: " & vBBMin(0) & " -- " & vBBMax(0)
    Debug.Print "                Y: " & vBBMin(1) & " -- " & vBBMax(1)
    Debug.Print "図心:           X: " & vCog(0)
    Debug.Print "                Y: " & vCog(1)
    Debug.Print "慣性モーメント: X: " & vMoI(0)
    Debug.Print "                Y: " & vMoI(1)
    Debug.Print "慣性乗積:      XY: " & vPoI
    Debug.Print "回転半径:       X: " & vRoG(0)
    Debug.Print "                Y: " & vRoG(1)
    Debug.Print "図心についての主慣性モーメントおよび X-Y 方向:"
    Debug.Print "                I: " & vPMoments(0) & " 方向 [" & vPDirs(0) & " , " & vPDirs(2) & "]"
    Debug.Print "                J: " & vPMoments(1) & " 方向 [" & vPDirs(1) & " , " & vPDirs(3) & "]"
    
    
    '//----- 主軸作成 -----//
    Const AXIS_LENGTH As Double = 1000
    Dim oLinPAxisX As AcadLine
    Dim oLinPAxisY As AcadLine
    Dim oColor As AcadAcCmColor
    Dim vCoordStart As Variant
    Dim vCoordEnd As Variant
    
    ReDim Preserve vCog(2)
    
    '主軸1作成
    vCoordStart = CalculateEndPoint(vCog(0), vCog(1), vPDirs(0), vPDirs(2), AXIS_LENGTH)    '始点座標計算
    vCoordEnd = CalculateEndPoint(vCog(0), vCog(1), -vPDirs(0), -vPDirs(2), AXIS_LENGTH)    '終点座標計算
    ReDim Preserve vCoordStart(2)
    ReDim Preserve vCoordEnd(2)
    Set oLinPAxisX = ThisDrawing.ModelSpace.AddLine(vCoordStart, vCoordEnd)

    '主軸2作成
    vCoordStart = CalculateEndPoint(vCog(0), vCog(1), vPDirs(1), vPDirs(3), AXIS_LENGTH)    '始点座標計算
    vCoordEnd = CalculateEndPoint(vCog(0), vCog(1), -vPDirs(1), -vPDirs(3), AXIS_LENGTH)    '終点座標計算
    ReDim Preserve vCoordStart(2)
    ReDim Preserve vCoordEnd(2)
    Set oLinPAxisY = ThisDrawing.ModelSpace.AddLine(vCoordStart, vCoordEnd)

    '軸色を設定
    Set oColor = New AcadAcCmColor
    Call oColor.SetRGB(0, 255, 0)
    oLinPAxisX.TrueColor = oColor
    oLinPAxisY.TrueColor = oColor

    '描画更新
    Call ThisDrawing.Regen(acActiveViewport)

    
End Sub
'--------------------------------------------------------------------
'-  始点座標と方向成分、長さから終点座標を計算する
'-      dX      :始点X座標
'-      dY      :始点Y座標
'-      dDirX   :X方向成分
'-      dDirY   :Y方向成分
'-      dLength :長さ
'-      戻り値  :終点のXY座標が入った配列
'--------------------------------------------------------------------
Private Function CalculateEndPoint(ByVal dStartX As Double, ByVal dStartY As Double, _
                                   ByVal dDirX As Double, ByVal dDirY As Double, _
                                   ByVal dLength As Double) As Double()
    Dim dCoordEnd(1) As Double
    Dim dMagnitude As Double
    Dim dVecUnitX As Double
    Dim dVecUnitY As Double
    Dim dEndX As Double
    Dim dEndY As Double
    
    '方向ベクトルの大きさを計算
    dMagnitude = Sqr(dDirX * dDirX + dDirY * dDirY)
    
    '単位ベクトルを計算
    dVecUnitX = dDirX / dMagnitude
    dVecUnitY = dDirY / dMagnitude
    
    '終点の座標を計算
    dEndX = dStartX + dVecUnitX * dLength
    dEndY = dStartY + dVecUnitY * dLength
    
    dCoordEnd(0) = dEndX
    dCoordEnd(1) = dEndY
    
    '結果を配列として返す
    CalculateEndPoint = dCoordEnd
    
End Function

 

コード解説 

ユーザー選択でリージョン取得

マスプロパティを取得する対象のリージョンをユーザー選択で取得するためには、UtilityオブジェクトのGetEntityメソッドを利用します。GetEntityメソッドは実行されるとユーザーの選択待ち状態となり対話的にユーザーが選択したオブジェクトを取得することができます。

    'ユーザー選択でリージョン取得
    On Error Resume Next
    Call ThisDrawing.Utility.GetEntity(oEntity, Empty, "リージョンを選択")
    On Error GoTo 0
    If TypeName(oEntity) <> "IAcadRegion" Then Exit Sub
    Set oRegion = oEntity

ユーザーが選択されたオブジェクトは第1引数の変数に、選択された座標は第2引数の変数にそれぞれ格納されます。第3引数はユーザー選択時に表示するメッセージで省略も可能です。GetEntityメソッドはユーザーが選択キャンセル([Esc]キーの押下)した場合にエラーが発生してしまうため、「On Error Resume Next」でエラーを無視する等の何らかの対策が必要になります。

サンプルコードでは変数「oEntity」にユーザーが選択されたオブジェクトが入るため、そのオブジェクトがリージョンであるかをTypeName関数を使って判定し、リージョンでなかったり選択されなかった場合(Nothingの場合)は処理を終了するようにしています。
 

マスプロパティの取得

[MASSPROP]コマンドで取得可能なマスプロパティはRegionオブジェクトのプロパティ/メソッドとしてすべて用意されています。それぞれ下記の通り取得が可能です。

    '//----- マスプロパティの取得 -----//
    dArea = oRegion.Area                        '<面積>
    dPerimeter = oRegion.perimeter              '<周囲>
    Call oRegion.GetBoundingBox(vBBMin, vBBMax) '<境界ボックス>
    vCog = oRegion.Centroid                     '<図心座標>
    vMoI = oRegion.momentOfInertia              '<慣性モーメント>
    vPoI = oRegion.ProductOfInertia             '<慣性乗積>
    vRoG = oRegion.RadiiOfGyration              '<回転半径>
    vPMoments = oRegion.PrincipalMoments        '<主慣性モーメント>
    vPDirs = oRegion.PrincipalDirections        '<主方向>

図心、慣性モーメント、慣性累積、回転半径、主慣性モーメントとその方向はすべて配列として複数値が返されるため、受け取る変数はVariant型で宣言しておく必要があります。

リージョンの境界ボックスの範囲はGetBoundingBoxメソッドを使うことで取得可能です。取得できる値はXY方向でリージョンを囲む最小の長方形を作成したときの最小(左下点)のXY座標と最大(右上点)のXY座標で、これらの数値だけあれば境界ボックスの高さや幅なども計算で求めることが可能です。
   

 主軸作成

RegionオブジェクトのPrincipalDirectionsメソッドにより取得できた情報はリージョンの主方向を表しています。サンプルコードでは図心からこの主方向に線分を作成しています。線分はModelSpaceオブジェクトのAddLineメソッドに始終点座標を入力することで作成が可能です。

    '主軸1作成
    vCoordStart = CalculateEndPoint(vCog(0), vCog(1), vPDirs(0), vPDirs(2), AXIS_LENGTH)    '始点座標計算
    vCoordEnd = CalculateEndPoint(vCog(0), vCog(1), -vPDirs(0), -vPDirs(2), AXIS_LENGTH)    '終点座標計算
    ReDim Preserve vCoordStart(2)
    ReDim Preserve vCoordEnd(2)
    Set oLinPAxisX = ThisDrawing.ModelSpace.AddLine(vCoordStart, vCoordEnd)

このとき線分の長さは定数値とし、始終点の座標は計算により求めています。

作成した線分の色の変更はAcCmColorオブジェクトにより設定することが可能です。
詳しくは「オブジェクトの色の取得と編集」を参照ください。
 

まとめ

マスプロパティの情報はRegionオブジェクトからすべて簡単に取得できるため、[MASSPROP]コマンドと同等の処理をVBAで再現するだけであればRegionオブジェクトさえ取得できればすぐに実装することが可能です。[MASSPROP]コマンドは取得した情報をファイル出力することは可能ですが、細かな設定はできません。VBAであれば、たとえばExcelの指定のセルに出力したり、表として出力したりなどの細かい処理を行うことも可能です。
  

メインページへ戻る
 

 関連書籍

2024年8月30日AutoCAD,VBA