Autodesk Community Tips- ADNオープン
Autodesk Community Tipsではちょっとしたコツ、やり方、ショートカット、アドバイスやヒントを共有しています。

AutoCAD VBA:フィールドを使った表の作成

Issue

VBA では表を TABLE オブジェクトで作成することが出来ますが、データ値にオブジェクトのプロパティをフィールドとして利用、表の内容を最新に保つようなことは出来ますか?

 

Solution
 TABLE オブジェクト のデータセルにフィールド文字を挿入することは可能です。どのようなフィールド文字列を値に設定するべきかは、FIELD[フィールド] コマンド 表示される [フィールド] ダイアログで、特定のオブジェクトと同オブジェクト タイプで利用可能なプロパティを選択すると、ダイアログ下部の「フィールド式」に表示される内容で取得することが出来ます。

 

このとき、特定のオブジェクトは AutoCAD API の識別子の 1つである ObjectId で関連付けされますので、VBA マクロでフィールド式をセルに指定する際に、適宜変更する必要があります。

 

field_dialog.jpg

 

次のマクロは、モデル空間に作図されているすべてのオブジェクトのハンドル番号とオブジェクト タイプ、オブジェクトの色を表に書き込むものです。色の情報がフィールド式で指定されているので、作図後に REGEN[再作図] コマンド を実行すると、値が更新されるようになります。

 

Option Explicit

Public Sub FieldTable()

    ' 新しい表スタイルの作成
    On Error Resume Next
    Dim oTblDict As AcadDictionary
    Set oTblDict = ThisDrawing.Dictionaries.Item("ACAD_TABLESTYLE")
    Dim oTblStyle As AcadTableStyle
    Set oTblStyle = oTblDict.Item("MyTableStyle")
    If Err Then

        ' 新しい表スタイル "MyTableStyle" を作成
        Err.Clear
        Set oTblStyle = oTblDict.AddObject("MyTableStyle", "AcDbTableStyle")
        
        ' タイトル欄の設定(背景色:青、文字色:白、文字高さ:4.0)
        Dim oColor As AcadAcCmColor
        Set oColor = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.25")
        oColor.ColorIndex = acWhite
        oTblStyle.SetColor acTitleRow, oColor
        oColor.ColorIndex = acBlue
        oTblStyle.SetBackgroundColorNone acTitleRow, False
        oTblStyle.SetBackgroundColor acTitleRow, oColor
        oTblStyle.SetTextHeight acTitleRow, 4#
        oTblStyle.TitleSuppressed = False

        ' 列見出し欄の色設定(背景色:白、文字色:緑、文字高さ:2.5)
        oColor.ColorIndex = acWhite
        oTblStyle.SetColor acHeaderRow, oColor
        oColor.ColorIndex = acGreen
        oTblStyle.SetBackgroundColorNone acHeaderRow, True
        oTblStyle.SetBackgroundColor acHeaderRow, oColor
        oTblStyle.SetTextHeight acHeaderRow, 2.5
        oTblStyle.HeaderSuppressed = False

        ' データ欄の色設定(背景色:なし、文字色:白、文字高さ:2)
        oColor.ColorIndex = acWhite
        oTblStyle.SetColor acDataRow, oColor
        oTblStyle.SetBackgroundColorNone acDataRow, True
        oTblStyle.SetTextHeight acDataRow, 2
        oTblStyle.SetAlignment acDataRow, acMiddleCenter
        
    End If

    ' 配置基点を指示
    Dim ptBase As Variant
    ThisDrawing.Utility.InitializeUserInput 1
    ptBase = ThisDrawing.Utility.GetPoint(, vbCrLf & "表の配置点を指定:")
    
    ' 表特性の算出
    Dim nRow As Integer
    Dim nCol As Integer
    Dim dHeight As Double
    nRow = ThisDrawing.ModelSpace.Count + 2 ' タイトル+列見出し
    nCol = 3
    dHeight = ThisDrawing.GetVariable("TEXTSIZE")
    
    ' 現在のレイアウトに表を配置
    Dim oTbl As IAcadTable
    Set oTbl = ThisDrawing.ActiveLayout.Block.AddTable(ptBase, nRow, nCol, dHeight, dHeight * 10#)
    
    oTbl.RegenerateTableSuppressed = True
    
    oTbl.StyleName = "MyTableStyle"
    oTbl.GenerateLayout
    
    ' タイトルの設定
    oTbl.SetText 0, 0, "モデル空間図形の色一覧"
    oTbl.SetRowHeight 0, 7#
    oTbl.SetText 1, 0, "ハンドル番号"
    oTbl.SetText 1, 1, "クラス名"
    oTbl.SetText 1, 2, "色"
    oTbl.SetRowHeight 1, 5#

    ' データの設定
    Dim nRowCnt As Integer
    Dim strField As String
    Dim oEnt As AcadEntity
    nRowCnt = 2
    For Each oEnt In ThisDrawing.ModelSpace
        
        ' ハンドル番号
        oTbl.SetText nRowCnt, 0, oEnt.Handle
        
        ' クラス名
        oTbl.SetText nRowCnt, 1, oEnt.ObjectName
        
        ' フィールド式(オブジェクトID で特定したオブジェクトの色)
        strField = "%<\AcObjProp Object(%<\_ObjId " & CStr(oEnt.ObjectID) & ">%).TrueColor>%"
        oTbl.SetText nRowCnt, 2, strField
        
        ' 行高さの設定
        oTbl.SetRowHeight nRowCnt, 5#
        
        ' 行カウンタ
        nRowCnt = nRowCnt + 1
    
    Next

    oTbl.RegenerateTableSuppressed = False

End Sub

 

このマクロコードでは、表スタイルを登録して表に使用しています。表スタイルの内容と図面の尺度が適切でない場合がありますので、必要に応じて文字高さ等を変更してください。AutoCAD VBA では、表スタイルは TableStyle オブジェクト で作成・編集することが出来ます。この例では、椅子のブロック参照の色を水色(cyan)から青(blue)に変更しています。

 

FieldTable.gif