Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.Windows

Public Class Class1

    ' エントリポイント用オプション インタフェースの実装
    Implements IExtensionApplication

    ' パレットセットとパレット用変数の宣言
    Public Shared oP As UserControl1 = Nothing
    Public Shared oPs As Autodesk.AutoCAD.Windows.PaletteSet = Nothing

    ' モジュール初期化処理
    Overridable Sub Initialize() Implements IExtensionApplication.Initialize

#If EventPrg Then ' プロジェクト プロパティのカスタム定数を True に設定して有効にできます
        Try

            ' ドキュメント イベント ハンドラの作成
            Dim oDocMan As DocumentCollection = Application.DocumentManager
            AddHandler oDocMan.DocumentCreated, AddressOf DocuemntCreatedHandler
            AddHandler oDocMan.DocumentToBeDestroyed, AddressOf DocumentToBeDestroyedHandler

        Finally
        End Try
#End If

    End Sub

    ' モジュール破棄処理
    Overridable Sub Terminate() Implements IExtensionApplication.Terminate

#If EventPrg Then ' プロジェクト プロパティのカスタム定数を True に設定して有効にできます
        Try

            ' ドキュメント イベント ハンドラの削除
            Dim oDocMan As DocumentCollection = Application.DocumentManager
            RemoveHandler oDocMan.DocumentCreated, AddressOf DocuemntCreatedHandler
            RemoveHandler oDocMan.DocumentToBeDestroyed, AddressOf DocumentToBeDestroyedHandler

        Finally
        End Try
#End If

    End Sub

    ' 名前空間を利用した例
    <CommandMethod("NameSpace1")> _
    Public Shared Sub NameSpace1()

        ' 名前空間を利用した例
        Dim oPt As Point3d
        oPt = New Point3d(0.0, 0.0, 0.0)

    End Sub

    ' 名前空間を利用しない例
    <CommandMethod("NameSpace2")> _
    Public Shared Sub NameSpace2()

        ' 名前空間を利用しない例
        Dim oPt As Autodesk.AutoCAD.Geometry.Point3d
        oPt = New Autodesk.AutoCAD.Geometry.Point3d(0.0, 0.0, 0.0)

    End Sub

    ' 名前空間を利用しない例(トランザクション マネージャ未使用)
    <CommandMethod("CreateLine1")> _
    Public Shared Sub CreateLine1()

        Try

            Dim oDb As Autodesk.AutoCAD.DatabaseServices.Database = Autodesk.AutoCAD.DatabaseServices.HostApplicationServices.WorkingDatabase

            Dim btObjId As Autodesk.AutoCAD.DatabaseServices.ObjectId = oDb.BlockTableId
            Dim oBt As Autodesk.AutoCAD.DatabaseServices.BlockTable = btObjId.Open(OpenMode.ForRead)

            Dim btrObjId As Autodesk.AutoCAD.DatabaseServices.ObjectId = oBt.Item("*MODEL_SPACE")
            oBt.Close()

            Dim oBtr As Autodesk.AutoCAD.DatabaseServices.BlockTableRecord = btrObjId.Open(OpenMode.ForWrite)

            Dim ptStart As Autodesk.AutoCAD.Geometry.Point3d = New Autodesk.AutoCAD.Geometry.Point3d(0.0, 0.0, 0.0)
            Dim ptEnd As Autodesk.AutoCAD.Geometry.Point3d = New Autodesk.AutoCAD.Geometry.Point3d(100.0, 100.0, 0.0)

            Dim oLine As Autodesk.AutoCAD.DatabaseServices.Line = New Autodesk.AutoCAD.DatabaseServices.Line(ptStart, ptEnd)

            oBtr.AppendEntity(oLine)
            oBtr.Close()

            oLine.Close()

        Catch oEx As Exception
            MsgBox(oEx.ToString())
        Finally
        End Try

    End Sub

    ' 名前空間を利用した例(トランザクション マネージャ未使用)
    <CommandMethod("CreateLine2")> _
    Public Shared Sub CreateLine2()

        Try

            Dim oDb As Database = HostApplicationServices.WorkingDatabase

            Dim btObjId As ObjectId = oDb.BlockTableId
            Dim oBt As BlockTable = btObjId.Open(OpenMode.ForRead)

            Dim btrObjId As ObjectId = oBt.Item("*MODEL_SPACE")
            oBt.Close()

            Dim oBtr As BlockTableRecord = btrObjId.Open(OpenMode.ForWrite)

            Dim ptStart As Point3d = New Point3d(0.0, 0.0, 0.0)
            Dim ptEnd As Point3d = New Point3d(100.0, 100.0, 0.0)

            Dim oLine As Line = New Line(ptStart, ptEnd)

            oBtr.AppendEntity(oLine)
            oBtr.Close()

            oLine.Close()

        Catch oEx As Exception
            MsgBox(oEx.ToString())
        Finally
        End Try

    End Sub

    ' 名前空間を利用した例(トランザクション マネージャ使用)
    <CommandMethod("CreateLine3")> _
    Public Shared Sub CreateLine3()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction

        Try

            Dim ptStart As Point3d = New Point3d(0.0, 0.0, 0.0)
            Dim ptEnd As Point3d = New Point3d(100.0, 100.0, 0.0)

            Dim oLine As Line = New Line(ptStart, ptEnd)

            Dim oBt As BlockTable = oTr.GetObject(oDb.BlockTableId, OpenMode.ForRead)

            Dim oBtr As BlockTableRecord = oTr.GetObject(oBt.Item("*MODEL_SPACE"), OpenMode.ForWrite)

            oBtr.AppendEntity(oLine)

            oTr.AddNewlyCreatedDBObject(oLine, True)
            oTr.Commit()

        Catch oEx As Exception
            MsgBox(oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' Using 使用例(トランザクション マネージャ使用)
    <CommandMethod("CreateLine4")> _
    Public Shared Sub CreateLine4()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Using oTr As Transaction = oDb.TransactionManager.StartTransaction

            Try

                Dim ptStart As Point3d = New Point3d(0.0, 0.0, 0.0)
                Dim ptEnd As Point3d = New Point3d(100.0, 100.0, 0.0)

                Dim oLine As Line = New Line(ptStart, ptEnd)

                Dim oBt As BlockTable = oTr.GetObject(oDb.BlockTableId, OpenMode.ForRead)

                Dim oBtr As BlockTableRecord = oTr.GetObject(oBt.Item("*MODEL_SPACE"), OpenMode.ForWrite)

                oBtr.AppendEntity(oLine)

                oTr.AddNewlyCreatedDBObject(oLine, True)
                oTr.Commit()

            Catch oEx As Exception
                MsgBox(oEx.ToString())
            Finally
                'oTr.Dispose()
            End Try

        End Using

    End Sub

    ' 一般的なユーザ入力使用例
    <CommandMethod("UserInput")> _
    Public Shared Sub UserInput()

        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Dim oInt1 As PromptIntegerResult = oEd.GetInteger(vbCrLf & "整数を入力:")
        If oInt1.Status <> PromptStatus.OK Then
            Exit Sub
        End If
        oEd.WriteMessage(vbCrLf + "入力値は " + oInt1.Value.ToString)

        Dim oIntPmt As PromptIntegerOptions = New PromptIntegerOptions(vbCrLf & "整数を入力:")
        oIntPmt.DefaultValue = 0
        Dim oInt2 As PromptIntegerResult = oEd.GetInteger(oIntPmt)
        If oInt2.Status <> PromptStatus.OK Then
            Exit Sub
        End If
        oEd.WriteMessage(vbCrLf + "入力値は " + oInt2.Value.ToString)

        Dim oDbl1 As PromptDoubleResult = oEd.GetDouble(vbCrLf & "実数を入力:")
        If oDbl1.Status <> PromptStatus.OK Then
            Exit Sub
        End If
        oEd.WriteMessage(vbCrLf + "入力値は " + oDbl1.Value.ToString)

        Dim oDblPmt As PromptDoubleOptions = New PromptDoubleOptions(vbCrLf & "実数を入力:")
        oDblPmt.DefaultValue = 0.0
        Dim oDbl2 As PromptDoubleResult = oEd.GetDouble(oDblPmt)
        If oDbl2.Status <> PromptStatus.OK Then
            Exit Sub
        End If
        oEd.WriteMessage(vbCrLf + "入力値は " + oDbl2.Value.ToString)

        Dim oPt1 As PromptPointResult = oEd.GetPoint(vbCrLf & "点を指定:")
        If oPt1.Status <> PromptStatus.OK Then
            Exit Sub
        End If
        oEd.WriteMessage(vbCrLf + "入力値は " + oPt1.Value.ToString)

        Dim oPtPmt As PromptPointOptions = New PromptPointOptions(vbCrLf & "点を指定:")
        oPtPmt.UseBasePoint = True
        oPtPmt.BasePoint = oPt1.Value
        Dim oPt2 As PromptPointResult = oEd.GetPoint(oPtPmt)
        If oPt2.Status <> PromptStatus.OK Then
            Exit Sub
        End If
        oEd.WriteMessage(vbCrLf + "入力値は " + oPt2.Value.ToString)

    End Sub

    ' ユーザ入力メソッドでのキーワード入力の使用例
    <CommandMethod("GetKeyword")> _
    Public Shared Sub GetKeyword()

        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Dim oIntPmt As PromptIntegerOptions = New PromptIntegerOptions(vbCrLf & "数値を入力[オプション1(O)/オプション2(P)/オプション3(T)]", "Option1 oPtion2 opTion3")
        oIntPmt.Keywords.Default = "Option1"

        Dim oInt As PromptIntegerResult = oEd.GetInteger(oIntPmt)
        If oInt.Status = PromptStatus.Keyword Then
            oEd.WriteMessage(vbCrLf + "キーワードは " + oInt.StringResult.ToString)
        ElseIf oInt.Status = PromptStatus.OK Then
            oEd.WriteMessage(vbCrLf + "入力値は " + oInt.Value.ToString)
        End If

    End Sub

    ' 単一オブジェクトの選択例
    <CommandMethod("PickEntity")> _
    Public Shared Sub PickEntity()

        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Dim oEnt1 As PromptEntityResult = oEd.GetEntity(vbCrLf & "オブジェクトを選択:")
        If oEnt1.Status <> PromptStatus.OK Then
            Exit Sub
        End If
        oEd.WriteMessage(vbCrLf + "オブジェクト ID は " + oEnt1.ObjectId.ToString)

    End Sub

    ' 複数オブジェクトの選択例(選択セット使用例)
    <CommandMethod("GetSSet")> _
    Public Shared Sub GetSSet()

        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Dim oSS As PromptSelectionResult = oEd.GetSelection
        If oSS.Status <> PromptStatus.OK Then
            Exit Sub
        End If

        Dim oSSet As SelectionSet = oSS.Value
        Dim objId As ObjectId
        For Each objId In oSSet.GetObjectIds
            oEd.WriteMessage(vbCrLf + "オブジェクト ID は " + objId.ToString)
        Next

    End Sub

    ' モーダル ダイアログの呼び出し例(Windows フォーム使用例)
    <CommandMethod("ShowDialog")> _
    Public Shared Sub ShowDialog()

        Dim oForm As Form1 = New Form1
        Application.ShowModalDialog(oForm)
        oForm.Dispose()

#If 0 Then
        Dim oForm As ColorDialog = New ColorDialog
        Dim oResult As System.Windows.Forms.DialogResult = oForm.ShowDialog()
        If (oResult = Windows.Forms.DialogResult.OK) Then
            MsgBox(oForm.Color.ToString)
        End If
#End If

#If 0 Then
        Dim oForm As SaveFileDialog = New SaveFileDialog("サンプル", "*.dwg", "dwg", "Hello", SaveFileDialog.SaveFileDialogFlags.NoUrls)
        Dim oResult As System.Windows.Forms.DialogResult = oForm.ShowDialog()
        If (oResult = Windows.Forms.DialogResult.OK) Then
            MsgBox(oForm.Filename.ToString)
        End If
#End If

    End Sub

    ' グラフィカル オブジェクトと非グラフィカル オブジェクトの連携例(ブロック定義とブロック参照)
    <CommandMethod("CreateBlock")> _
    Public Shared Sub CreateBlock()

        ' 変数宣言
        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Try

            ' Test ブロック定義の有無確認
            Dim oBt As BlockTable = oTr.GetObject(oDb.BlockTableId, OpenMode.ForWrite)
            Dim oBlkDef As BlockTableRecord
            If Not oBt.Has("Test") Then

                ' Test ブロック定義の作成
                Dim oCirc As Circle = New Circle(Point3d.Origin, Vector3d.ZAxis, 10.0)
                oBlkDef = New BlockTableRecord
                oBlkDef.Name = "Test"
                oBt.Add(oBlkDef) ' ブロック定義を先に DB 登録(eNotInDatabase 防止)
                oTr.AddNewlyCreatedDBObject(oBlkDef, True)
                oBlkDef.AppendEntity(oCirc)
                oTr.AddNewlyCreatedDBObject(oCirc, True)

            Else
                oBlkDef = oTr.GetObject(oBt.Item("Test"), OpenMode.ForWrite)
            End If

            ' ブロック参照の作成
            Dim oPt As Point3d = New Point3d(100.0, 100.0, 0.0)
            Dim oBlkRef As BlockReference = New BlockReference(oPt, oBlkDef.ObjectId)

            ' モデル空間に配置
            Dim oCurBtr As BlockTableRecord = oTr.GetObject(oBt.Item("*MODEL_SPACE"), OpenMode.ForWrite)
            oCurBtr.AppendEntity(oBlkRef)
            oTr.AddNewlyCreatedDBObject(oBlkRef, True)
            oTr.Commit()

        Catch oEx As Exception
            oEd.WriteMessage(vbCrLf + oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' 古いオープン/クローズ メカニズムを使ったオブジェクトの色変更
    <CommandMethod("OldChangeColor")> _
    Public Shared Sub OldChangeColor()

        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim oEnt As Entity = Nothing

        Try

            Dim oResult As PromptEntityResult
            oResult = oEd.GetEntity(vbCrLf & "オブジェクトを選択:")
            If oResult.Status <> PromptStatus.OK Then
                Exit Sub
            End If

            Dim oId As ObjectId = oResult.ObjectId
            oEnt = oId.Open(OpenMode.ForWrite)

            oEnt.ColorIndex = 1
        Catch ex As Exception
            MsgBox(ex.ToString)
        Finally
            If Not oEnt Is Nothing Then
                oEnt.Close()
            End If
        End Try

    End Sub

    ' 画層テーブルの走査例
    <CommandMethod("GetAllLayer")> _
    Public Shared Sub GetAllLayer()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Try

            Dim oLt As LayerTable = oTr.GetObject(oDb.LayerTableId, OpenMode.ForRead)
            Dim oId As ObjectId
            Dim oLtr As LayerTableRecord

            For Each oId In oLt
                oLtr = oTr.GetObject(oId, OpenMode.ForRead)
                oEd.WriteMessage(vbCrLf + oLtr.Name + " - " + oLtr.GetRXClass.DxfName + "(" + oLtr.GetRXClass.Name + "):" + oLtr.ObjectId.ToString)
            Next

            ' IEnumerator を直接使用する場合
            'Dim oEnu As IEnumerator = oLt.GetEnumerator
            'While oEnu.MoveNext()
            '    oId = CType(oEnu.Current(), ObjectId)
            '    oLtr = oTr.GetObject(oId, OpenMode.ForRead)
            '    oEd.WriteMessage(vbCrLf + oLtr.Name + " - " + oLtr.GetRXClass.DxfName + "(" + oLtr.GetRXClass.Name + "):" + oLtr.ObjectId.ToString)
            'End While

            oTr.Commit()

        Catch oEx As Exception
            oEd.WriteMessage(vbCrLf + oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' モデル空間の走査例
    <CommandMethod("GetAllEntity")> _
    Public Shared Sub GetAllEntity()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Try

            Dim oBt As BlockTable = oTr.GetObject(oDb.BlockTableId, OpenMode.ForRead)
            Dim oBtr As BlockTableRecord = oTr.GetObject(oBt.Item("*MODEL_SPACE"), OpenMode.ForRead)

            Dim oId As ObjectId
            Dim oEnt As Entity

            For Each oId In oBtr
                oEnt = oTr.GetObject(oId, OpenMode.ForRead)
                oEd.WriteMessage(vbCrLf + oEnt.GetRXClass.DxfName + "(" + oEnt.GetRXClass.Name + "):" + oEnt.ObjectId.ToString)
            Next

            ' IEnumerator を直接使用する場合
            'Dim oEnu As IEnumerator = oBtr.GetEnumerator
            'While oEnu.MoveNext()
            '   oId = CType(oEnu.Current(), ObjectId)
            '   oEnt = oTr.GetObject(oId, OpenMode.ForRead)
            '   oEd.WriteMessage(vbCrLf + oEnt.GetRXClass.DxfName + "(" + oEnt.GetRXClass.Name + "):" + oEnt.ObjectId.ToString)
            'End While

            oTr.Commit()

        Catch oEx As Exception
            MsgBox(oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' オブジェクトの識別例(ObjetARX 定義クラス名の表示)
    <CommandMethod("CheckClass")> _
    Public Shared Sub CheckClass()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Try

            Dim oEntRslt As PromptEntityResult = oEd.GetEntity(vbCrLf & "オブジェクトを選択:")
            If oEntRslt.Status <> PromptStatus.OK Then
                Throw New System.Exception("オブジェクト未選択")
            End If

            Dim oEnt As Entity = oTr.GetObject(oEntRslt.ObjectId, OpenMode.ForRead)

            oEd.WriteMessage(oEnt.GetRXClass.Name)

            oTr.Commit()

        Catch oEx As Exception
            MsgBox(oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' オブジェクトの識別例(選択オブジェクトが円かチェック)
    <CommandMethod("CheckCircle")> _
    Public Shared Sub CheckCircle()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Try

            Dim oEntRslt As PromptEntityResult = oEd.GetEntity(vbCrLf & "オブジェクトを選択:")
            If oEntRslt.Status <> PromptStatus.OK Then
                Throw New System.Exception("オブジェクト未選択")
            End If

            Dim oEnt As Entity = oTr.GetObject(oEntRslt.ObjectId, OpenMode.ForRead)

            'oEd.WriteMessage(vbCrLf + oEnt.GetRXClass.Name)
            'oEd.WriteMessage(vbCrLf + RXClass.GetClass(GetType(Circle)).Name)

            If TypeOf oEnt Is Circle Then
                Dim oCircle As Circle = CType(oEnt, Circle)
                oEd.WriteMessage(vbCrLf + "円の半径は " + oCircle.Radius.ToString)
            Else
                oEd.WriteMessage(vbCrLf + "円ではありません")
            End If

            oTr.Commit()

        Catch oEx As Exception
            MsgBox(oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' オブジェクトの識別例2(選択オブジェクトが円かチェック)
    <CommandMethod("CheckCircle2")> _
    Public Shared Sub CheckCircle2()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Try

            Dim oEntRslt As PromptEntityResult = oEd.GetEntity(vbCrLf & "オブジェクトを選択:")
            If oEntRslt.Status <> PromptStatus.OK Then
                Throw New System.Exception("オブジェクト未選択")
            End If

            Dim oEnt As Entity = oTr.GetObject(oEntRslt.ObjectId, OpenMode.ForRead)

            If oEnt.GetRXClass = RXClass.GetClass(GetType(Circle)) Then
                Dim oCircle As Circle = CType(oEnt, Circle)
                oEd.WriteMessage(vbCrLf + "円の半径は " + oCircle.Radius.ToString)
            Else
                oEd.WriteMessage(vbCrLf + "円ではありません")
            End If

            oTr.Commit()

        Catch oEx As Exception
            MsgBox(oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' 画層の作成例
    <CommandMethod("CreateLayer")> _
    Public Shared Sub CreateLayer()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Try

            Dim oLt As LayerTable = oTr.GetObject(oDb.LayerTableId, OpenMode.ForWrite)
            Dim oLtr As LayerTableRecord
            Dim oLtrId As ObjectId
            If Not oLt.Has("新画層") Then
                oLtr = New LayerTableRecord
                oLtr.Name = "新画層"
                oLt.Add(oLtr)
                oTr.AddNewlyCreatedDBObject(oLtr, True)
                oLtrId = oLtr.ObjectId
                MsgBox("新画層を新規に作成しました")
            Else
                MsgBox("新画層は既に存在していました")
            End If

            oTr.Commit()

        Catch oEx As Exception
            MsgBox(oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' スタティック コマンドの例(ドキュメント毎のデータを意識しない)
    Shared cnt1 As Integer = 0
    <CommandMethod("StaticCommand")> _
    Public Shared Sub StaticCommand()
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        oEd.WriteMessage(vbCrLf + "現在値は " + cnt1.ToString)

        Dim oResult As PromptIntegerResult = oEd.GetInteger(vbCrLf & "整数を入力:")
        If oResult.Status <> PromptStatus.OK Then
            Exit Sub
        End If
        cnt1 = oResult.Value
    End Sub

    ' インスタンス コマンドの例(ドキュメント毎のデータを区別する)
    Dim cnt2 As Integer = 0
    <CommandMethod("InstanceCommand")> _
    Public Sub InstanceCommand()
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        oEd.WriteMessage(vbCrLf + "現在値は " + cnt2.ToString)

        Dim oResult As PromptIntegerResult = oEd.GetInteger(vbCrLf & "整数を入力:")
        If oResult.Status <> PromptStatus.OK Then
            Exit Sub
        End If
        cnt2 = oResult.Value
    End Sub

    ' 属性付きブロック定義の作成とブロック参照の配置
    <CommandMethod("CreateBlock2")> _
    Public Shared Sub CreateBlock2()

        ' 変数宣言
        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Try

            ' Test ブロック定義の有無確認
            Dim oBt As BlockTable = oTr.GetObject(oDb.BlockTableId, OpenMode.ForWrite)
            Dim oBlkDef As BlockTableRecord
            If Not oBt.Has("Test") Then

                ' Test ブロック定義の作成
                Dim oCirc As Circle = New Circle(Point3d.Origin, Vector3d.ZAxis, 10.0)
                oBlkDef = New BlockTableRecord
                oBlkDef.Name = "Test"
                oBt.Add(oBlkDef) ' ブロック定義を先に DB 登録(eNotInDatabase 防止)
                oTr.AddNewlyCreatedDBObject(oBlkDef, True)
                oBlkDef.AppendEntity(oCirc)
                oTr.AddNewlyCreatedDBObject(oCirc, True)
                Dim oAttDef As AttributeDefinition = New AttributeDefinition
                oAttDef.Position = Point3d.Origin
                oAttDef.TextString = "属性値"
                oAttDef.Tag = "タグ値"
                oAttDef.Prompt = "属性値を入力："
                oBlkDef.AppendEntity(oAttDef)
                oTr.AddNewlyCreatedDBObject(oAttDef, True)

            Else
                oBlkDef = oTr.GetObject(oBt.Item("Test"), OpenMode.ForWrite)
            End If

            ' ブロック参照の作成
            Dim oPt As Point3d = New Point3d(100.0, 100.0, 0.0)
            Dim oBlkRef As BlockReference = New BlockReference(oPt, oBlkDef.ObjectId)

            ' モデル空間に配置
            Dim oCurBtr As BlockTableRecord = oTr.GetObject(oBt.Item("*MODEL_SPACE"), _
                                                            OpenMode.ForWrite)
            oCurBtr.AppendEntity(oBlkRef)
            oTr.AddNewlyCreatedDBObject(oBlkRef, True)

            oTr.Commit()

        Catch oEx As Autodesk.AutoCAD.Runtime.Exception
            oEd.WriteMessage(vbCrLf + oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' 拡張ディクショナリの付加
    <CommandMethod("AddXRec")> _
    Public Sub AddXRec()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Try

            Dim oLt As LayerTable = oTr.GetObject(oDb.LayerTableId, OpenMode.ForRead)
            Dim oId As ObjectId = oLt.Item("0")
            Dim oLtr As LayerTableRecord = oTr.GetObject(oId, OpenMode.ForWrite)

            oId = oLtr.ExtensionDictionary
            If oId.IsNull Then
                oLtr.CreateExtensionDictionary()
                oId = oLtr.ExtensionDictionary
            End If

            ' カスタム データをディクショナリに追加する例()
            Dim oRb As ResultBuffer = New ResultBuffer
            oRb.Add(New TypedValue(DxfCode.Text, "カスタム データ"))
            oRb.Add(New TypedValue(DxfCode.Real, 99999.999))
            oRb.Add(New TypedValue(DxfCode.Int16, 123))
            Dim oData As Xrecord = New Xrecord
            oData.Data = oRb

            Dim oDict As DBDictionary = oTr.GetObject(oId, OpenMode.ForWrite)
            oDict.SetAt("トレーニング", oData) ' 同一名のディクショナリが存在する場合は自動的に削除される
            oTr.AddNewlyCreatedDBObject(oData, True)

            oTr.Commit()

        Catch oEx As Autodesk.AutoCAD.Runtime.Exception
            oEd.WriteMessage(vbCrLf + oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' 拡張ディクショナリの参照
    <CommandMethod("GetXRec")> _
    Public Sub GetXRec()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Try

            Dim oLt As LayerTable = oTr.GetObject(oDb.LayerTableId, OpenMode.ForRead)
            Dim oId As ObjectId = oLt.Item("0")
            Dim oLtr As LayerTableRecord = oTr.GetObject(oId, OpenMode.ForRead)

            oId = oLtr.ExtensionDictionary
            If oId.IsNull Then
                Throw New Autodesk.AutoCAD.Runtime.Exception("拡張ディクショナリが付加されていません ...")
            End If

            Dim oDict As DBDictionary = oTr.GetObject(oId, OpenMode.ForRead)

            If Not oDict.Contains("トレーニング") Then
                Throw New Autodesk.AutoCAD.Runtime.Exception("0 画層に トレーニング 拡張ディクショナリが付加されていません ...")
            End If

            oId = oDict.GetAt("トレーニング")

            Dim oData As Xrecord = oTr.GetObject(oId, OpenMode.ForRead)
            Dim oRb As ResultBuffer = oData.Data

            ' カスタム データをディクショナリから取得する例
            If oRb.AsArray(0).TypeCode = DxfCode.Text Then
                oEd.WriteMessage(vbCrLf + "拡張ディクショナリ内の文字:" + oRb.AsArray(0).Value)
            Else
                Throw New Autodesk.AutoCAD.Runtime.Exception("拡張ディクショナリから文字を取得できません ...")
            End If
            If oRb.AsArray(1).TypeCode = DxfCode.Real Then
                oEd.WriteMessage(vbCrLf + "拡張ディクショナリ内の実数:" + oRb.AsArray(1).Value.ToString)
            Else
                Throw New Autodesk.AutoCAD.Runtime.Exception("拡張ディクショナリから実数を取得できません ...")
            End If
            If oRb.AsArray(2).TypeCode = DxfCode.Int16 Then
                oEd.WriteMessage(vbCrLf + "拡張ディクショナリ内の整数:" + oRb.AsArray(2).Value.ToString)
            Else
                Throw New Autodesk.AutoCAD.Runtime.Exception("拡張ディクショナリから整数を取得できません ...")
            End If

            oTr.Commit()

        Catch oEx As Autodesk.AutoCAD.Runtime.Exception
            oEd.WriteMessage(vbCrLf + oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' 拡張ディクショナリの削除
    <CommandMethod("RemXRec")> _
    Public Sub RemXRec()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Try

            Dim oLt As LayerTable = oTr.GetObject(oDb.LayerTableId, OpenMode.ForRead)
            Dim oId As ObjectId = oLt.Item("0")
            Dim oLtr As LayerTableRecord = oTr.GetObject(oId, OpenMode.ForWrite)

            oId = oLtr.ExtensionDictionary
            If oId.IsNull Then
                Throw New Autodesk.AutoCAD.Runtime.Exception("拡張ディクショナリが付加されていません ...")
            End If

            Dim oDict As DBDictionary = oTr.GetObject(oId, OpenMode.ForRead)

            If Not oDict.Contains("トレーニング") Then
                Throw New Autodesk.AutoCAD.Runtime.Exception("0 画層に  トレーニング 拡張ディクショナリが付加されていません ...")
            End If

            oId = oDict.GetAt("トレーニング")

            Dim oData As Xrecord = oTr.GetObject(oId, OpenMode.ForWrite)
            oData.Erase()

            oTr.Commit()

        Catch oEx As Autodesk.AutoCAD.Runtime.Exception
            oEd.WriteMessage(vbCrLf + oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

#If EventPrg Then ' プロジェクト プロパティのカスタム定数を True に設定して有効にできます
    ' ドキュメント イベント ハンドラの作成
    <CommandMethod("AddDocEvent")> _
    Public Sub AddDocEvent()
        Dim oDoc As Document = Application.DocumentManager.MdiActiveDocument
        AddHandler oDoc.CommandWillStart, AddressOf CommandWillStartHandler
        AddHandler oDoc.CommandEnded, AddressOf CommandEndedHandler
    End Sub

    ' ドキュメント イベント ハンドラの削除
    <CommandMethod("RemDocEvent")> _
    Public Sub RemDocEvent()
        Dim oDoc As Document = Application.DocumentManager.MdiActiveDocument
        RemoveHandler oDoc.CommandWillStart, AddressOf CommandWillStartHandler
        RemoveHandler oDoc.CommandEnded, AddressOf CommandEndedHandler
    End Sub

    ' Lesson 8 データベース イベント
    ' データベース イベント ハンドラの作成
    <CommandMethod("AddDBEvent")> _
    Public Sub AddDBEvent()
        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        AddHandler oDb.ObjectAppended, AddressOf ObjectAppendedHandler
        AddHandler oDb.ObjectErased, AddressOf ObjectErasedHandler
    End Sub

    ' データベース イベント ハンドラの削除
    <CommandMethod("RemDBEvent")> _
    Public Sub RemDBEvent()
        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        RemoveHandler oDb.ObjectAppended, AddressOf ObjectAppendedHandler
        RemoveHandler oDb.ObjectErased, AddressOf ObjectErasedHandler
    End Sub

    ' ドキュメント作成後の呼び出しハンドラ
    Private Shared Sub DocuemntCreatedHandler(ByVal sender As Object, ByVal e As DocumentCollectionEventArgs)
        MsgBox("ドキュメント作成後の呼び出しハンドラ")
    End Sub

    ' ドキュメント破棄直前の呼び出しハンドラ
    Private Shared Sub DocumentToBeDestroyedHandler(ByVal sender As Object, ByVal e As DocumentCollectionEventArgs)
        MsgBox("ドキュメント破棄直前の呼び出しハンドラ")
    End Sub

    ' コマンド実行直前の呼び出しハンドラ
    Private Shared Sub CommandWillStartHandler(ByVal sender As Object, ByVal e As CommandEventArgs)
        MsgBox(e.GlobalCommandName & " コマンド実行直前の呼び出しハンドラ")
    End Sub

    ' コマンド終了後の呼び出しハンドラ
    Private Shared Sub CommandEndedHandler(ByVal sender As Object, ByVal e As CommandEventArgs)
        MsgBox(e.GlobalCommandName & " コマンド終了後の呼び出しハンドラ")
    End Sub

    ' オブジェクト追加後の呼び出しハンドラ
    Private Shared Sub ObjectAppendedHandler(ByVal sender As Object, ByVal e As ObjectEventArgs)
        MsgBox(e.DBObject.GetRXClass.DxfName & " オブジェクト追加後の呼び出しハンドラ")
    End Sub

    ' オブジェクト削除後の呼び出しハンドラ
    Private Shared Sub ObjectErasedHandler(ByVal sender As Object, ByVal e As ObjectErasedEventArgs)
        MsgBox(e.DBObject.GetRXClass.DxfName & " オブジェクト削除後の呼び出しハンドラ")
    End Sub
#End If

    ' Lesson 1 プロジェクトとコマンドの作成
    <CommandMethod("Hello")> _
    Public Shared Sub MyCommand()
        Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbCrLf + "Hello World!")
    End Sub

    ' Lesson 2  モデル空間に円を追加
    <CommandMethod("CreateCircle")> _
    Public Shared Sub CreateCircle()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction

        Try

            Dim ptCenter As Point3d = New Point3d(50.0, 50.0, 0.0)
            Dim vecNormal As Vector3d = New Vector3d(0.0, 0.0, 1.0)

            ' コンストラクタを使った場合
            'Dim oCircle As Circle = New Circle(ptCenter, vecNormal, 50.0)

            ' コンストラクタを使わない場合
            Dim oCircle As Circle = New Circle
            oCircle.Center = ptCenter
            oCircle.Normal = vecNormal
            oCircle.Radius = 50.0

            Dim oBt As BlockTable = oTr.GetObject(oDb.BlockTableId, OpenMode.ForRead)

            Dim oBtr As BlockTableRecord = oTr.GetObject(oBt.Item("*MODEL_SPACE"), OpenMode.ForWrite)

            oBtr.AppendEntity(oCircle)

            oTr.AddNewlyCreatedDBObject(oCircle, True)
            oTr.Commit()

        Catch oEx As Exception
            MsgBox(oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' Lesson 3 ユーザ対話で円を追加
    <CommandMethod("CreateCircle2")> _
    Public Shared Sub CreateCircle2()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Try

            Dim oPt As PromptPointResult = oEd.GetPoint(vbCrLf & "円の中心点を指定:")
            If oPt.Status <> PromptStatus.OK Then
                Exit Sub
            End If

            Dim oOption As PromptDistanceOptions = New PromptDistanceOptions(vbCrLf & "円の半径を入力:")
            oOption.UseBasePoint = True
            oOption.BasePoint = oPt.Value
            Dim oRadius As PromptDoubleResult = oEd.GetDistance(oOption)
            If oRadius.Status <> PromptStatus.OK Then
                Exit Sub
            End If

            ' コンストラクタを使った場合
            'Dim oCircle As Circle = New Circle(oPt.Value, vecNormal, oRadius.Value)

            ' コンストラクタを使わない場合
            Dim oCircle As Circle = New Circle
            oCircle.Center = oPt.Value
            oCircle.Normal = New Vector3d(0.0, 0.0, 1.0)
            oCircle.Radius = oRadius.Value

            Dim oBt As BlockTable = oTr.GetObject(oDb.BlockTableId, OpenMode.ForRead)

            Dim oBtr As BlockTableRecord = oTr.GetObject(oBt.Item("*MODEL_SPACE"), OpenMode.ForWrite)

            oBtr.AppendEntity(oCircle)

            oTr.AddNewlyCreatedDBObject(oCircle, True)
            oTr.Commit()

        Catch oEx As Exception
            MsgBox(oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' Lesson 4 選択したオブジェクトの色を変更
    <CommandMethod("ChangeColor")> _
    Public Shared Sub ChangeColor()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Try

            Dim oEntRslt As PromptEntityResult = oEd.GetEntity(vbCrLf & "オブジェクトを選択:")
            If oEntRslt.Status <> PromptStatus.OK Then
                Throw New System.Exception("オブジェクト未選択")
                'Exit Sub
            End If

            Dim oEnt As Entity = oTr.GetObject(oEntRslt.ObjectId, OpenMode.ForWrite)

            ' 256色指定の場合
            'oEnt.ColorIndex = 1

            ' True Color 指定の場合
            oEnt.Color = Color.FromRgb(255, 0, 0)

            oTr.Commit()

        Catch oEx As Exception
            MsgBox(oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' Lesson 5 パレット ダイアログの作成
    <CommandMethod("ShowPalette")> _
    Public Shared Sub ShowPalette()

        ' パレットセットの作成
        If oPs Is Nothing Then
            oPs = New Autodesk.AutoCAD.Windows.PaletteSet("文字スタイル")
            oPs.Style = PaletteSetStyles.ShowPropertiesMenu Or _
                           PaletteSetStyles.ShowAutoHideButton Or _
                           PaletteSetStyles.ShowCloseButton Or _
                           PaletteSetStyles.Snappable
            oPs.MinimumSize = New System.Drawing.Size(200, 150)
            oPs.Visible = True
        Else
            oPs.Visible = True
        End If

        ' パレットの作成
        If oPs.Count = 0 Then
            oP = New UserControl1
            oPs.Add("文字スタイル作成", oP)
        End If
        oPs.Dock = DockSides.None
        oPs.Size = New System.Drawing.Size(200, 150)

    End Sub

    ' Lesson 6 作成した円の画層を指定
    <CommandMethod("AttachLayer")> _
    Public Shared Sub AttachLayer()

        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction
        Dim oEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Try

            Dim oLt As LayerTable = oTr.GetObject(oDb.LayerTableId, OpenMode.ForWrite)
            Dim oLtr As LayerTableRecord
            Dim oLtrId As ObjectId
            If Not oLt.Has("トレーニング") Then
                oLtr = New LayerTableRecord
                oLtr.Name = "トレーニング"

                Dim oColor As Color
                'oColor = Color.FromRgb(255, 255, 0) ' True Color の場合
                oColor = Color.FromColorIndex(ColorMethod.ByAci, 2) ' インデックス番号の場合
                oLtr.Color = oColor

                oLt.Add(oLtr)
                oTr.AddNewlyCreatedDBObject(oLtr, True)
                oLtrId = oLtr.ObjectId
                MsgBox("トレーニング画層を新規に作成しました")
            Else
                oLtr = oTr.GetObject(oLt.Item("トレーニング"), OpenMode.ForRead)
                oLtrId = oLtr.ObjectId
                MsgBox("トレーニング画層は既に存在していました")
            End If

            Dim oPt As PromptPointResult = oEd.GetPoint(vbCrLf & "円の中心点を指定:")
            If oPt.Status <> PromptStatus.OK Then
                Exit Sub
            End If

            Dim oOption As PromptDistanceOptions = New PromptDistanceOptions(vbCrLf & "円の半径を入力:")
            oOption.UseBasePoint = True
            oOption.BasePoint = oPt.Value
            Dim oRadius As PromptDoubleResult = oEd.GetDistance(oOption)
            If oRadius.Status <> PromptStatus.OK Then
                Exit Sub
            End If

            ' コンストラクタを使った場合
            Dim oCircle As Circle = New Circle(oPt.Value, New Vector3d(0.0, 0.0, 1.0), oRadius.Value)
            oCircle.LayerId = oLtrId

            Dim oBt As BlockTable = oTr.GetObject(oDb.BlockTableId, OpenMode.ForRead)

            Dim oBtr As BlockTableRecord = oTr.GetObject(oBt.Item("*MODEL_SPACE"), OpenMode.ForWrite)

            oBtr.AppendEntity(oCircle)

            oTr.AddNewlyCreatedDBObject(oCircle, True)

            oTr.Commit()

        Catch oEx As Exception
            MsgBox(oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' Lesson 7 Web サービスの呼び出し
    <CommandMethod("CallWeb")> _
    Public Shared Sub CallWeb()

        Dim oForm As Form2 = New Form2
        Application.ShowModalDialog(oForm)
        oForm.Dispose()

    End Sub

    ' Lesson 8 データベース イベント
    ' #If EventPrg Then ~ #End If 内に実装

    ' Lesson 9 Web 拡張エンティティデータの付加
    ' 拡張データの付加
    <CommandMethod("AddXData")> _
    Public Sub AddXData()

        ' 変数宣言
        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction()
        Dim oEd As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor

        Try

            Dim oEntRst As PromptEntityResult
            oEntRst = oEd.GetEntity(vbCrLf & "トレーニング 拡張エンティティ データを付加する任意のオブジェクトを選択:")
            If oEntRst.Status <> PromptStatus.OK Then
                Throw New System.Exception("オブジェクト未選択")
                'Exit Sub
            End If

            Dim oStrPmt As PromptStringOptions = New PromptStringOptions(vbCrLf & "氏名を入力:")
            oStrPmt.AllowSpaces = True
            oStrPmt.UseDefaultValue = True
            oStrPmt.DefaultValue = "***"
            Dim oStr As PromptResult = oEd.GetString(oStrPmt)
            If oStr.Status <> PromptStatus.OK Then
                Throw New System.Exception("不正な氏名")
                'Exit Sub
            End If

            Dim oDblPmt As PromptDoubleOptions = New PromptDoubleOptions(vbCrLf & "身長を入力:")
            oDblPmt.DefaultValue = 160.0
            oDblPmt.AllowNegative = False
            oDblPmt.AllowZero = False
            oDblPmt.AllowNone = False
            Dim oDbl As PromptDoubleResult = oEd.GetDouble(oDblPmt)
            If oDbl.Status <> PromptStatus.OK Then
                Throw New System.Exception("不正な身長")
                'Exit Sub
            End If

            Dim oIntPmt As PromptIntegerOptions = New PromptIntegerOptions(vbCrLf & "年齢を入力:")
            oIntPmt.DefaultValue = 0
            oIntPmt.AllowNegative = False
            oIntPmt.AllowNone = False
            Dim oInt As PromptIntegerResult = oEd.GetInteger(oIntPmt)
            If oInt.Status <> PromptStatus.OK Then
                Throw New System.Exception("不正な体重")
                'Exit Sub
            End If

            Dim oEnt As Entity
            oEnt = oTr.GetObject(oEntRst.ObjectId, OpenMode.ForWrite)

            Dim oTbl As RegAppTable
            oTbl = oTr.GetObject(oDb.RegAppTableId, OpenMode.ForWrite, False)
            If Not oTbl.Has("トレーニング") Then
                Dim oRec As RegAppTableRecord
                oRec = New RegAppTableRecord
                oRec.Name = "トレーニング"
                oTbl.Add(oRec)
                oTr.AddNewlyCreatedDBObject(oRec, True)
            End If

            oEnt.XData = New ResultBuffer(New TypedValue(1001, "トレーニング"), _
                                          New TypedValue(1002, "{"), _
                                          New TypedValue(1000, oStr.StringResult), _
                                          New TypedValue(1040, oDbl.Value), _
                                          New TypedValue(1070, oInt.Value), _
                                          New TypedValue(1002, "}"))

            oTr.Commit()

        Catch oEx As Exception
            oEd.WriteMessage(vbCrLf + oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

    ' 拡張データの取得
    <CommandMethod("GetXData")> _
    Public Sub GetXData()

        ' 変数宣言
        Dim oDb As Database = HostApplicationServices.WorkingDatabase
        Dim oTr As Transaction = oDb.TransactionManager.StartTransaction()
        Dim oEd As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor

        Try

            Dim oRst As PromptEntityResult
            oRst = oEd.GetEntity(vbCrLf & "トレーニング 拡張エンティティ データを参照するオブジェクトを選択:")

            Dim oEnt As Entity
            oEnt = oTr.GetObject(oRst.ObjectId, OpenMode.ForRead)

            Dim oTbl As RegAppTable
            oTbl = oTr.GetObject(oDb.RegAppTableId, OpenMode.ForWrite, False)
            If Not oTbl.Has("トレーニング") Then
                Dim oRec As RegAppTableRecord
                oRec = New RegAppTableRecord
                oRec.Name = "トレーニング"
                oTbl.Add(oRec)
                oTr.AddNewlyCreatedDBObject(oRec, True)
            End If

            Dim oRB As ResultBuffer = oEnt.XData
            If Not IsNothing(oRB) Then
                Dim oWK As TypedValue
                Dim oEnu As IEnumerator = oRB.GetEnumerator()
                While oEnu.MoveNext()
                    oWK = CType(oEnu.Current(), TypedValue)
                    oWK.GetType.ToString()
                    oEd.WriteMessage(vbCrLf + oWK.TypeCode.ToString + " = " + oWK.Value.ToString)
                End While
            Else
                oEd.WriteMessage(vbCrLf + "トレーニング 拡張エンティティ データは付加されていません...")
            End If

            oTr.Commit()

        Catch oEx As Exception
            oEd.WriteMessage(vbCrLf + oEx.ToString())
        Finally
            oTr.Dispose()
        End Try

    End Sub

End Class
