'******************************************************************************
' 定義 :Private Function CreateSortedTable()
' 概要 :ソートしたテーブル・フィーチャクラスの取得
' 備考 :元のテーブルをソートしてInMemoryWorkspaceへ出力して返す
' 第1引数 :Table 入力テーブル・フィーチャクラス
' 第2引数 :FieldName ソート対象フィールド名
' 第3引数 :Ascending (オプション デフォルト値:True)昇順
' 第4引数 :CaseSensitive (オプション デフォルト値:False)大文字・小文字の区別
' 戻り値 :ITable Table・FeatureClass
' 更新履歴 :2010-04-16 作成
'******************************************************************************
Private Function CreateSortedTable(Table As ITable, FieldName As String, Optional Ascending As Boolean = True, Optional CaseSensitive As Boolean = False) As ITable
Dim pTableSort As ITableSort
Set pTableSort = New TableSort
pTableSort.Ascending(FieldName) = Ascending
pTableSort.CaseSensitive(FieldName) = CaseSensitive
pTableSort.Fields = FieldName
Set pTableSort.Table = Table
pTableSort.Sort Nothing
Dim pCursor As ICursor
Set pCursor = pTableSort.Rows
Dim pFeatureWorkspace As IFeatureWorkspace
Set pFeatureWorkspace = GetInMemoryWorkspace("temp")
Dim pTable As ITable
If Table Is IFeatureClass Then
Set pTable = pFeatureWorkspace.CreateFeatureClass("Temp", Table.Fields, Nothing, Nothing, esriFTSimple, "Shape", "")
Else
Set pTable = pFeatureWorkspace.CreateTable("Temp", Table.Fields, Nothing, Nothing, "")
End If
Dim i As Long
Dim pRow As IRow
Set pRow = pCursor.NextRow
Dim pInsertCursor As ICursor
Set pInsertCursor = pTable.Insert(True)
Dim pInsertRow As IRow
Set pInsertRow = pTable.CreateRowBuffer
Do Until pRow Is Nothing
For i = 1 To pTable.Fields.FieldCount - 1
If Not pRow.Fields.Field(i).Name = "Shape_Length" And _
Not pRow.Fields.Field(i).Name = "Shape_Area" And _
Not pRow.Fields.Field(i).Name = "OBJECTID" Then
pInsertRow.Value(i) = pRow.Value(i)
End If
Next i
pInsertCursor.InsertRow pInsertRow
Set pRow = pCursor.NextRow
Loop
pInsertCursor.Flush
Set SortTable = pTable
End Function
'******************************************************************************
' 定義 :Private Function GetInMemoryWorkspace()
' 概要 :InMemoryWorkspaceの取得
' 備考 :このWorkspaceではCreateFeatureDatasetやCreateQyeryDefは無効
' 第1引数 :String Workspace名
' 第2引数 :Boolean (オプション デフォルト値:True)InMemoryWorkspaceを新規作成するかどうか
' 第3引数 :IPropertySet (オプション デフォルト値:Nothing)DBMSへの接続情報
' 第4引数 :Long (オプション デフォルト値:0)ウィンドウ ハンドル
' 戻り値 :IWorkspace Workspace
' 更新履歴 :2008-05-28 作成
'******************************************************************************
Private Function GetInMemoryWorkspace(Name As String, Optional Create As Boolean = True, Optional ConnectionProperties As IPropertySet = Nothing, Optional hWnd As Long = 0) As IWorkspace
Dim pWorkspaceFactory As IWorkspaceFactory
Dim pName As IName
Set pWorkspaceFactory = New InMemoryWorkspaceFactory
If Create = True Then
Set pName = pWorkspaceFactory.Create("", Name, ConnectionProperties, hWnd)
Set GetInMemoryWorkspace = pName.Open
Else
Set GetInMemoryWorkspace = pWorkspaceFactory.Open(ConnectionProperties, hWnd)
End If
End Function
記事
