<P>如何删除记录</P>
<P>本例要实现的是如何在FeatureClass中删除一条记录（Feature）。 </P>
<P>l   要点</P>
<P>获得游标IFeatureCursor，然后定义IFeature接口对象，并获得要删除的记录，最后使用IFeature.Delete方法删除记录。</P>
<P>主要用到IFeature接口和IFeatureCursor接口。</P>
<P>l   程序说明</P>
<P>函数OpenFeatureClass获得当前激活的Map中第一层的IFeatureClass接口对象。</P>
<P>函数DeleteFeature删除PLACENAME字段值为”Insert Land”的所有记录。</P>
<P>l   代码</P>
<P>
<P>Private Sub DeleteFeature(pFeatureClass As IFeatureClass)</P>
<P>    Dim pFeature                As IFeature</P>
<P>    Dim pFeatureCursor          As IFeatureCursor</P>
<P>    Dim pQueryFilter            As IQueryFilter</P>
<P>    Dim nFeatureNumber          As Integer</P>
<P>On Error GoTo ErrorHandler:</P>
<P>    If (pFeatureClass Is Nothing) Then</P>
<P>        Exit Sub</P>
<P>    End If</P>
<P>    Set pQueryFilter = New QueryFilter</P>
<P>    pQueryFilter.WhereClause = "PLACENAME = 'Insert Land'"</P>
<P>    Set pFeatureCursor = pFeatureClass.Search(pQueryFilter, False)</P>
<P>    Set pFeature = pFeatureCursor.NextFeature</P>
<P>    nFeatureNumber = 0</P>
<P>    Do While Not pFeature Is Nothing</P>
<P>        pFeature.Delete</P>
<P>        nFeatureNumber = nFeatureNumber + 1</P>
<P>        Set pFeature = pFeatureCursor.NextFeature</P>
<P>    Loop</P>
<P>    MsgBox ("Delete　" ; nFeatureNumber ; "　Features")</P>
<P>    Exit Sub</P>
<P>ErrorHandler:</P>
<P>    MsgBox Err.Description</P>
<P>End Sub</P>
<P>Private Function OpenFeatureClass() As IFeatureClass</P>
<P>    Dim pMxDocument             As IMxDocument</P>
<P>    Dim pMap                    As IMap</P>
<P>    Dim pFeatureLayer           As IFeatureLayer</P>
<P>    Dim pFeatureClass           As IFeatureClass</P>
<P>On Error GoTo ErrorHandler:</P>
<P>    Set OpenFeatureClass = Nothing</P>
<P>    Set pMxDocument = ThisDocument</P>
<P>    Set pMap = pMxDocument.FocusMap</P>
<P>    If (pMap.LayerCount = 0) Then</P>
<P>        MsgBox ("缺少数据")</P>
<P>        Exit Function</P>
<P>    End If</P>
<P>    Set pFeatureLayer = pMap.Layer(0)</P>
<P>    Set pFeatureClass = pFeatureLayer.FeatureClass</P>
<P>    Set OpenFeatureClass = pFeatureClass</P>
<P>    Exit Function</P>
<P>ErrorHandler:</P>
<P>    MsgBox Err.Description</P>
<P>End Function </P>
<P>Private Sub UIButtonControl1_Click()</P>
<P>On Error GoTo ErrorHandler:</P>
<P>    Dim pFeatureClass           As IFeatureClass</P>
<P>    Set pFeatureClass = OpenFeatureClass()</P>
<P>    DeleteFeature pFeatureClass</P>
<P>    Exit Sub</P>
<P>ErrorHandler:</P>
<P>    MsgBox Err.Description</P>
<P>End Sub</P>
<br>

<P>如何纪录排序(ITableSort)\</P>
<P 17.95pt">本例要实现的是如何将一个FeatureClass中的数据按某字段的值进行排序。</P>
<P 39pt; TEXT-INDENT: -42pt">l   要点</P>
<P 17.95pt">定义ITableSort接口对象，并用TableSort类实现之，设置排序所用到的字段、排序方式（升序或降序）以及排序的数据源，然后使用ITableSort.Sort方法进行排序。</P>
<P 17.95pt">主要用到ITableSort接口。</P>
<P 39pt; TEXT-INDENT: -42pt">l   程序说明</P>
<P 17.95pt">函数OpenFeatureClass获得当前激活的Map中第一层的IFeatureClass接口对象。</P>
<P 17.95pt">函数SortFeatures按照pFeatureClass的第五个字段值对pFeatureClass的数据进行从小到大排序，并返回一个排好序的ICursor接口对象。</P>
<P 39pt; TEXT-INDENT: -42pt">l   代码</P>
<TABLE height=43 width=541 align=center border=0><!--DWLayoutTable-->

<TR>
<TD vAlign=top width=535 height=75>
<P 10pt">Private Function SortFeatures(pFeatureClass As IFeatureClass) As ICursor</P>
<P 10pt">    Dim pTableSort          As ITableSort</P>
<P 10pt">    Dim pFields             As IFields</P>
<P 10pt">    Dim pField              As IField</P>
<P 10pt">    Dim pQueryFilter        As IQueryFilter</P>
<P 10pt">    Dim pCursor             As ICursor</P>
<P 10pt">On Error GoTo ErrorHandler:</P>
<P 10pt">    Set SortFeatures = Nothing</P>
<P 10pt">    Set pFields = pFeatureClass.Fields</P>
<P 10pt">    Set pField = pFields.Field(5)</P>
<P 10pt">    Set pTableSort = New esriCore.TableSort</P>
<P 10pt">    Set pQueryFilter = New QueryFilter</P>
<P 10pt">    Set pCursor = Nothing    </P>
<P 10pt">    With pTableSort</P>
<P 10pt">        .Fields = pField.Name</P>
<P 10pt">        .Ascending(pField.Name) = True</P>
<P 10pt">        .CaseSensitive(pField.Name) = True</P>
<P 10pt">        Set .QueryFilter = pQueryFilter</P>
<P 10pt">        Set .Table = pFeatureClass</P>
<P 10pt">    End With</P>
<P 10pt">    pTableSort.Sort Nothing</P>
<P 10pt">    Set pCursor = pTableSort.Rows</P>
<P 10pt">    Set SortFeatures = pCursor</P>
<P 10pt">    If (pCursor Is Nothing) Then</P>
<P 10pt">        MsgBox ("未排序")</P>
<P 10pt">    Else</P>
<P 10pt">        MsgBox ("排序完成")</P>
<P 10pt">    End If</P>
<P 10pt">    Exit Function</P>
<P 10pt">ErrorHandler:</P>
<P 10pt">    MsgBox Err.Description</P>
<P 10pt">End Function</P>
<P 10pt">Private Function OpenFeatureClass() As IFeatureClass</P>
<P 10pt">    Dim pMxDocument             As IMxDocument</P>
<P 10pt">    Dim pMap                    As IMap</P>
<P 10pt">    Dim pFeatureLayer           As IFeatureLayer</P>
<P 10pt">    Dim pFeatureClass           As IFeatureClass</P>
<P 10pt">On Error GoTo ErrorHandler:</P>
<P 10pt">    Set OpenFeatureClass = Nothing</P>
<P 10pt">    Set pMxDocument = ThisDocument</P>
<P 10pt">    Set pMap = pMxDocument.FocusMap</P>
<P 10pt">    If (pMap.LayerCount = 0) Then</P>
<P 10pt">        MsgBox ("缺少数据")</P>
<P 10pt">        Exit Function</P>
<P 10pt">    End If</P>
<P 10pt">    Set pFeatureLayer = pMap.Layer(0)</P>
<P 10pt">    Set pFeatureClass = pFeatureLayer.FeatureClass</P>
<P 10pt">    Set OpenFeatureClass = pFeatureClass</P>
<P 10pt">    Exit Function</P>
<P 10pt">ErrorHandler:</P>
<P 10pt">    MsgBox Err.Description</P>
<P 10pt">End Function</P>
<P 10pt">Private Sub UIButtonControl1_Click()</P>
<P 10pt">On Error GoTo ErrorHandler:</P>
<P 10pt">    Dim pFeatureClass           As IFeatureClass</P>
<P 10pt">    Set pFeatureClass = OpenFeatureClass()</P>
<P 10pt">    SortFeatures pFeatureClass</P>
<P 10pt">    Exit Sub</P>
<P 10pt">ErrorHandler:</P>
<P 10pt">    MsgBox Err.Description</P>
<P 10pt">End Sub</P>
<P 10pt">Private Sub UIButtonControl1_Click()</P>
<P 10pt">On Error GoTo ErrorHandler:</P>
<P 10pt">    Dim pFeatureClass           As IFeatureClass</P>
<P 10pt">    Set pFeatureClass = OpenFeatureClass()</P>
<P 10pt">    SortFeatures pFeatureClass</P>
<P 10pt">    Exit Sub</P>
<P 10pt">ErrorHandler:</P>
<P 10pt">    MsgBox Err.Description</P>
<P 10pt">End Sub</P></TD></TR></TABLE>

<P>如何添加字段</P>

<P>本例实现的是如何在一个FeatureClass中新增一个字段(Field)。</P>
<P>l   要点</P>
<P>定义IField接口对象，并用Field类实现,通过IFieldEdit接口对象设置IField接口对象的属性,最后通过IFeatureClass.AddField方法添加一个字段。</P>
<P>主要用到IField接口、IFieldEdit接口和IFeatureClass接口。</P>
<P>l   程序说明</P>
<P>函数OpenFeatureClass获得当前激活的Map中第一层的IFeatureClass接口对象。</P>
<P>函数AddField生成一个新的字段(Field)并添加到pFeatureClass中。</P>
<P>l   代码</P>
<P>Private Function AddField(pFeatureClass As IFeatureClass) As Boolean</P>
<P>    Dim pField                  As IField</P>
<P>    Dim pFieldEdit              As IFieldEdit</P>
<P>On Error GoTo ErrorHandler:</P>
<P>    AddField = False</P>
<P>    If (pFeatureClass Is Nothing) Then</P>
<P>        Exit Function</P>
<P>    End If        </P>
<P>    Set pField = New esriCore.Field</P>
<P>    Set pFieldEdit = pField</P>
<P>    With pFieldEdit</P>
<P>        .Length = 10</P>
<P>        .Name = "NewField"</P>
<P>        .Type = esriFieldTypeString</P>
<P>    End With</P>
<P>    pFeatureClass.AddField pField</P>
<P>    MsgBox ("已添加新字段:" ; "  " ; pField.Name)</P>
<P>    AddField = True</P>
<P>    Exit Function</P>
<P>ErrorHandler:</P>
<P>    MsgBox Err.Description</P>
<P>End Function</P>
<P>Private Function OpenFeatureClass() As IFeatureClass</P>
<P>    Dim pMxDocument             As IMxDocument</P>
<P>    Dim pMap                    As IMap</P>
<P>    Dim pFeatureLayer           As IFeatureLayer</P>
<P>    Dim pFeatureClass           As IFeatureClass</P>
<P>On Error GoTo ErrorHandler:</P>
<P>    Set OpenFeatureClass = Nothing</P>
<P>    Set pMxDocument = ThisDocument</P>
<P>    Set pMap = pMxDocument.FocusMap</P>
<P>    If (pMap.LayerCount = 0) Then</P>
<P>        MsgBox ("缺少数据")</P>
<P>        Exit Function</P>
<P>    End If</P>
<P>    Set pFeatureLayer = pMap.Layer(0)</P>
<P>    Set pFeatureClass = pFeatureLayer.FeatureClass</P>
<P>    Set OpenFeatureClass = pFeatureClass</P>
<P>    Exit Function</P>
<P>ErrorHandler:</P>
<P>    MsgBox Err.Description</P>
<P>End Function</P>
<P>Private Sub UIButtonControl1_Click()</P>
<P>On Error GoTo ErrorHandler:</P>
<P>    Dim pFeatureClass        As IFeatureClass</P>
<P>    Set pFeatureClass = OpenFeatureClass()</P>
<P>    AddField pFeatureClass</P>
<P>    Exit Sub</P>
<P>ErrorHandler:</P>
<P>    MsgBox Err.Description</P>
<P>End Sub</P>

感谢总统<img src="images/post/smile/dvbbs/em01.gif" />

 如何删除字段
<P 17.95pt">本例实现的是如何在一个FeatureClass中删除一个字段(Field)。</P>
<P 39pt; TEXT-INDENT: -42pt">l   要点</P>
<P 17.95pt">定义IField接口实例，并使用Field类实现，使用IFields.FindField方法和IFields.Field方法获得IFeatureClass中要删除的字段，最后用IFeatureClass.DeleteField方法删除字段。</P>
<P 17.95pt">主要用到IFields接口，IField接口和IFeatureClass接口。</P>
<P 39pt; TEXT-INDENT: -42pt">l   程序说明</P>
<P 17.95pt">函数OpenFeatureClass获得当前激活的Map中第一层的IFeatureClass接口对象。</P>
<P 17.95pt">函数DeleteField删除pFeatureClass中字段名为NewField的字段。</P>
<P 39pt; TEXT-INDENT: -42pt">l   代码</P>
<P>
<TABLE height=43 width=541 align=center border=0><!--DWLayoutTable-->

<TR>
<TD vAlign=top width=535 height=75>
<P 10pt">Private Function DeleteField(pFeatureClass As IFeatureClass) As Boolean</P>
<P 10pt">    Dim pFields                 As IFields</P>
<P 10pt">    Dim pField                  As IField</P>
<P 10pt">    Dim lFieldNumber            As Long</P>
<P 10pt">On Error GoTo ErrorHandler:</P>
<P 10pt">    DeleteField = False</P>
<P 10pt">    If (pFeatureClass Is Nothing) Then</P>
<P 10pt">        Exit Function</P>
<P 10pt">    End If</P>
<P 10pt">    Set pFields = pFeatureClass.Fields</P>
<P 10pt">    lFieldNumber = pFields.FindField("NewField")</P>
<P 10pt">    If (lFieldNumber = -1) Then</P>
<P 10pt">        MsgBox ("无此字段")</P>
<P 10pt">        Exit Function</P>
<P 10pt">    End If</P>
<P 10pt">    Set pField = pFields.Field(lFieldNumber)</P>
<P 10pt">    pFeatureClass.DeleteField pField</P>
<P 10pt">    MsgBox ("已删除字段:" ; "NewField")</P>
<P 10pt">    DeleteField = True</P>
<P 10pt">    Exit Function</P>
<P 10pt">ErrorHandler:</P>
<P 10pt">    MsgBox Err.Description</P>
<P 10pt">End Function</P>
<P 10pt">Private Function OpenFeatureClass() As IFeatureClass</P>
<P 10pt">    Dim pMxDocument             As IMxDocument</P>
<P 10pt">    Dim pMap                    As IMap</P>
<P 10pt">    Dim pFeatureLayer           As IFeatureLayer</P>
<P 10pt">    Dim pFeatureClass           As IFeatureClass</P>
<P 10pt">On Error GoTo ErrorHandler:</P>
<P 10pt">    Set OpenFeatureClass = Nothing</P>
<P 10pt">    Set pMxDocument = ThisDocument</P>
<P 10pt">    Set pMap = pMxDocument.FocusMap</P>
<P 10pt">    If (pMap.LayerCount = 0) Then</P>
<P 10pt">        MsgBox ("缺少数据")</P>
<P 10pt">        Exit Function</P>
<P 10pt">    End If</P>
<P 10pt">    Set pFeatureLayer = pMap.Layer(0)</P>
<P 10pt">    Set pFeatureClass = pFeatureLayer.FeatureClass</P>
<P 10pt">    Set OpenFeatureClass = pFeatureClass</P>
<P 10pt">    Exit Function</P>
<P 10pt">ErrorHandler:</P>
<P 10pt">    MsgBox Err.Description</P>
<P 10pt">End Function </P>
<P 10pt">Private Sub UIButtonControl1_Click()</P>
<P 10pt">On Error GoTo ErrorHandler:</P>
<P 10pt">    Dim pFeatureClass        As IFeatureClass</P>
<P 10pt">    Set pFeatureClass = OpenFeatureClass()</P>
<P 10pt">    DeleteField pFeatureClass</P>
<P 10pt">    Exit Sub</P>
<P 10pt">ErrorHandler:</P>
<P 10pt">    MsgBox Err.Description</P>
<P 10pt">End Sub</P></TD></TR></TABLE></P>

<P>如何进行空间查询</P>
<P>本例实现的是在一个图层上画一个polygon，根据该polygon查询出图层上与之相交的polygon并高亮显示出来。</P>
<P>l   要点</P>
<P>通过RubberPolygon类来实现接口IRubberBand接口对象，用IRubberBand.TrackNew方法在图层上画出polygon,然后定义IGeometry获得该polygon,创建ISpatialFilter接口对象实现过滤功能，通过ILayer接口实例获得IFeatureSelection接口，调用。</P>
<P>IFeatureSelection.SelectFeatures方法将结果高亮显示。</P>
<P>l   程序说明</P>
<P>过程UIToolControl1_MouseDown是实现模块。</P>
<P>l   代码</P>
<P>
<P>Option Explicit</P>
<P>Private Function UIToolControl1_Deactivate() As Boolean</P>
<P>    UIToolControl1_Deactivate = True</P>
<P>End Function</P>
<P>Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, _ ByVal x As Long, ByVal y As Long)</P>
<P>    Dim pMxDoc                  As IMxDocument</P>
<P>    Dim pActiveView             As IActiveView</P>
<P>    Dim pScreenDisplay          As IScreenDisplay</P>
<P>    Dim pRubberPolygon          As IRubberBand</P>
<P>    Dim pFillSymbol             As ISimpleFillSymbol</P>
<P>    Dim pRgbColor               As IRgbColor</P>
<P>    Dim pPolygon                As IPolygon</P>
<P>    Dim pGeometry               As IGeometry</P>
<P>    Dim pFeatselect             As IFeatureSelection</P>
<P>    Dim pSpatialFilter          As ISpatialFilter</P>
<P>On Error GoTo ErrorHandler:</P>
<P>    Set pMxDoc = ThisDocument</P>
<P>    Set pActiveView = pMxDoc.FocusMap</P>
<P>    'Draw Polygon</P>
<P>    Set pScreenDisplay = pActiveView.ScreenDisplay</P>
<P>    Set pRubberPolygon = New RubberPolygon</P>
<P>    Set pFillSymbol = New SimpleFillSymbol</P>
<P>    Set pRgbColor = New RgbColor</P>
<P>    pRgbColor.NullColor = True</P>
<P>    pFillSymbol.Color = pRgbColor</P>
<P>    Set pPolygon = pRubberPolygon.TrackNew(pScreenDisplay, pFillSymbol)</P>
<P>    With pScreenDisplay</P>
<P>        .StartDrawing pScreenDisplay.hDC, esriNoScreenCache</P>
<P>        .SetSymbol pFillSymbol</P>
<P>        .DrawPolygon pPolygon</P>
<P>        .FinishDrawing</P>
<P>    End With</P>
<P>    'set up pFilter</P>
<P>    Set pGeometry = pPolygon</P>
<P>    Set pSpatialFilter = New SpatialFilter</P>
<P>    With pSpatialFilter</P>
<P>    Set .Geometry = pGeometry</P>
<P>        .SpatialRel = esriSpatialRelIntersects</P>
<P>    End With</P>
<P>    'select</P>
<P>    Set pFeatselect = pMxDoc.FocusMap.Layer(0)</P>
<P>    pFeatselect.SelectFeatures pSpatialFilter, esriSelectionResultNew, False</P>
<P>    pFeatselect.SelectionSet.Refresh</P>
<P>    pMxDoc.ActiveView.Refresh</P>
<P>    Exit Sub</P>
<P>ErrorHandler:</P>
<P>    MsgBox Err.Description</P>
<P>End Sub</P>
<br>

支持！

<P>如何进行高级空间查询(两个层之间的空间查询)</P>
<P>本例实现的是在Map的两个Poylgon图层中，查询出第一个Polygon层中的Poylgon被第二个Polygon层的Polygon包含的所有记录</P>
<P>l   要点</P>
<P>定义IGeometryCollection接口实例，并使用GeometryBag类实现，将查询图层所有记录的图形信息添加进去。创建ISpatialFilter接口实例来设置空间查询运算符，本例设为esriSpatialRelContains。通过查询层Featurelayer获得IFeatureSelection接口实例，最后使用IFeatureSelection.SelectFeatures方法实现本例。</P>
<P>l   程序说明</P>
<P>本例使用的数据为“WorldCountries.shp”和“USUrbanAreas.shp”。</P>
<P>过程UIButtonControl1_Click是实现模块。</P>
<P>l   代码</P>
<P>
<P>Option Explicit</P>
<P>Private Sub UIButtonControl1_Click()</P>
<P>    Dim pMxDoc                      As IMxDocument</P>
<P>    Dim pMap                        As IMap</P>
<P>    Dim pQueryFeatLayer             As IFeatureLayer</P>
<P>    Dim pFeatLayer                  As IFeatureLayer</P>
<P>    Dim pFeatureClass               As IFeatureClass</P>
<P>    Dim pInFeatureCursor            As IFeatureCursor</P>
<P>    Dim pOutFeatureCursor           As IFeatureCursor</P>
<P>    Dim pFeature                    As IFeature</P>
<P>    Dim pFeatselect                 As IFeatureSelection</P>
<P>    Dim pFilter                     As ISpatialFilter</P>
<P>    Dim pGeoCollection              As IGeometryCollection</P>
<P>On Error GoTo Err_Handle:</P>
<P>    Set pMxDoc = ThisDocument</P>
<P>    Set pMap = pMxDoc.FocusMap</P>
<P>    'according to the name of layers to set up featurelayer</P>
<P>    If pMap.Layer(1).Name = "WorldCountries" Then</P>
<P>        Set pFeatLayer = pMap.Layer(1)</P>
<P>        Set pQueryFeatLayer = pMap.Layer(0)</P>
<P>    Else</P>
<P>        Set pFeatLayer = pMap.Layer(0)</P>
<P>        Set pQueryFeatLayer = pMap.Layer(1)</P>
<P>    End If</P>
<P>    Set pFeatureClass = pFeatLayer.FeatureClass</P>
<P>    Set pGeoCollection = New esriCore.GeometryBag</P>
<P>    Set pOutFeatureCursor = pFeatureClass.Search(Nothing, False)</P>
<P>    Set pFeature = pOutFeatureCursor.NextFeature</P>
<P>    ' add feature into pGeoCollection</P>
<P>    Do While Not pFeature Is Nothing</P>
<P>        pGeoCollection.AddGeometry pFeature.Shape</P>
<P>        Set pFeature = pOutFeatureCursor.NextFeature</P>
<P>    Loop</P>
<P>    Set pFilter = New SpatialFilter</P>
<P>    'set up pFilter</P>
<P>    With pFilter</P>
<P>    Set .Geometry = pGeoCollection</P>
<P>        .GeometryField = "Shape"</P>
<P>.SpatialRel = esriSpatialRelContains</P>
<P>    End With</P>
<P>    Set pFeatselect = pQueryFeatLayer</P>
<P>    'filter the features and display the results in screen</P>
<P>    pFeatselect.SelectFeatures pFilter, esriSelectionResultNew, False</P>
<P>    pFeatselect.SelectionSet.Refresh</P>
<P>    pMxDoc.ActiveView.Refresh</P>
<P>    Exit Sub</P>
<P>Err_Handle:</P>
<P>    MsgBox Err.Description</P>
<P>End Sub</P>
<br>

<P>如何进行层与层之间的逻辑运算</P>
<br>
<P>本例要实现的是将两个同一GeometryType图层联合成为一个图层，输出Shape文件，并且加载到Map中显示出来。</P>
<P>l   要点</P>
<P>定义ITable的两个接口变量，通过两个图层FeatureClass实例化。然后由接口IFeatureClassName、IWorkspaceName和IDatasetName实现创建一个新的shape文件。再创建IBasicGeoprocessor接口对象，使用IBasicGeoprocessor.Union方法实现两个图层的联合。</P>
<P>l   程序说明</P>
<P>过程UIButtonControl1_Click是实现模块。</P>
<P>l   代码</P>
<P>
<P>Option Explicit</P>
<P>Private Sub UIButtonControl1_Click()</P>
<P>    Dim pMxDoc                  As IMxDocument</P>
<P>    Dim pLayer                  As ILayer</P>
<P>    Dim pInputTable             As ITable</P>
<P>    Dim pOverlayTable           As ITable</P>
<P>    Dim pFeatClassName          As IFeatureClassName</P>
<P>    Dim pNewWSName              As IWorkspaceName</P>
<P>    Dim pDatasetName            As IDatasetName</P>
<P>    Dim dtol                    As Double</P>
<P>    Dim pBasicGeop              As IBasicGeoprocessor</P>
<P>    Dim pOutputFeatClass        As IFeatureClass</P>
<P>    Dim pOutputFeatLayer        As IFeatureLayer</P>
<P>    Dim App                     As VBProject</P>
<P>On Error GoTo ErrorHandler:</P>
<P>    Set pMxDoc = ThisDocument</P>
<P>    Set pLayer = pMxDoc.FocusMap.Layer(0)</P>
<P>    Set App = ThisDocument.VBProject</P>
<P>    ' Get the input table</P>
<P>    ' Use the Itable interface from the Layer (not from the FeatureClass)</P>
<P>    Set pInputTable = pLayer</P>
<P>    ' Get the overlay layer and table</P>
<P>    ' Use the Itable interface from the Layer (not from the FeatureClass)</P>
<P>    Set pLayer = pMxDoc.FocusMap.Layer(1)</P>
<P>    Set pOverlayTable = pLayer</P>
<P>    ' Error checking</P>
<P>    If pInputTable Is Nothing Then</P>
<P>        MsgBox "Table QI failed"</P>
<P>        Exit Sub</P>
<P>    End If</P>
<P>    If pOverlayTable Is Nothing Then</P>
<P>        MsgBox "Table QI failed"</P>
<P>        Exit Sub</P>
<P>    End If</P>
<P>    ' Define the output feature class name</P>
<P>Set pFeatClassName = New FeatureClassName</P>
<P>' Set output location and feature class name</P>
<P>Set pNewWSName = New WorkspaceName</P>
<P>pNewWSName.WorkspaceFactoryProgID = "esriCore.ShapeFileWorkspaceFactory.1"</P>
<P>    pNewWSName.PathName = App.FileName ; "\.."</P>
<P>    Set pDatasetName = pFeatClassName</P>
<P>    pDatasetName.Name = "Union_result"</P>
<P>    Set pDatasetName.WorkspaceName = pNewWSName</P>
<P>    ' Set the tolerance.  Passing 0.0 causes the default tolerance to be used.</P>
<P>    ' The default tolerance is 1/10,000 of the extent of the data frame's spatial domain</P>
<P>    dtol = 0#</P>
<P>    ' Perform the union</P>
<P>    Set pBasicGeop = New BasicGeoprocessor</P>
<P>    Set pOutputFeatClass = pBasicGeop.Union(pInputTable, False, pOverlayTable, False, _dtol, pFeatClassName)</P>
<P>    ' Add the output layer to the map</P>
<P>    Set pOutputFeatLayer = New FeatureLayer</P>
<P>    Set pOutputFeatLayer.FeatureClass = pOutputFeatClass</P>
<P>    pOutputFeatLayer.Name = pOutputFeatClass.AliasName</P>
<P>    pMxDoc.FocusMap.AddLayer pOutputFeatLayer</P>
<P>    Exit Sub</P>
<P>ErrorHandler:</P>
<P>    MsgBox Err.Description</P>
<P>End Sub</P>
<p>

<P>如何将shape文件转化成GeoDataBase(各种文件格式的转换)</P>
<P>本例演示的是如何将shape文件转化成personal GeoDatabase文件，其它格式间的与此转换类似。主要用到IFeatureDataConverter接口的ConvertFeatureClass方法。</P>
<P>l   要点</P>
<P>首先，创建新的GeoDataBase数据库，并创建IFeatureDatasetName对象。创建定义两个IFeatureClassName接口对象分别引用输入表（shape文件）和输出表。</P>
<P>然后设置输出表的Shape字段的GeormetryDef属性。这一步非常关键，因为其中包含了数据库和shape文件的空间参考信息。</P>
<P>最后调用IFeatureDataConverter.ConvertFeatureClass方法完成功能。</P>
<P>l   程序说明</P>
<P>过程UIBConvert_Click是实现模块，调用过程ConvertShapeToGeodatabase实现功能。</P>
<P>sDataPath定义了数据与工程文件的相对路径。SHAPE_NAME描述了要转化的shape文件的文件名。MDB_NAME和F_DS_NAME分别描述了Access数据库名和库的数据集的名称。</P>
<P>l   代码</P>
<P>Option Explicit</P>
<P>Private Sub UIBConvert_Click()</P>
<P>    Call ConvertShapeToGeodatabase</P>
<P>End Sub</P>
<P>Private Sub ConvertShapeToGeodatabase()</P>
<P>    Dim pOutWorkspaceFactory    As IWorkspaceFactory</P>
<P>    Dim pOutWorkspaceName       As IWorkspaceName</P>
<P>    Dim pInWorkspaceName        As IWorkspaceName</P>
<P>    Dim pOutFeatureDSName       As IFeatureDatasetName</P>
<P>    Dim pOutDSName              As IDatasetName</P>
<P>    Dim pInFeatureClassName     As IFeatureClassName</P>
<P>    Dim pInDatasetName          As IDatasetName</P>
<P>    Dim pOutFeatureClassName    As IFeatureClassName</P>
<P>    Dim pOutDatasetName         As IDatasetName</P>
<P>    Dim iCounter                As Long</P>
<P>    Dim pOutFields              As IFields</P>
<P>    Dim pInFields               As IFields</P>
<P>    Dim pFieldChecker           As IFieldChecker</P>
<P>    Dim pGeoField               As IField</P>
<P>    Dim pOutGeometryDef         As IGeometryDef</P>
<P>    Dim pOutGeometryDefEdit     As IGeometryDefEdit</P>
<P>    Dim pName                   As IName</P>
<P>    Dim pInFeatureClass         As IFeatureClass</P>
<P>    Dim pShpToFeatClsConverter  As IFeatureDataConverter</P>
<P>    Dim pVBProject              As VBProject</P>
<P>    Dim sDataPath               As String</P>
<P>    Const SHAPE_NAME As String = "country"</P>
<P>    Const MDB_NAME As String = "countryDB"</P>
<P>    Const F_DS_NAME As String = "World"</P>
<P>    On Error GoTo ErrorHandler</P>
<P>    Set pVBProject = ThisDocument.VBProject</P>
<P>    sDataPath = pVBProject.FileName ; "\..\..\..\..\data\"</P>
<P>    If Not "" = Dir(sDataPath ; MDB_NAME ; ".mdb") Then</P>
<P>        MsgBox MDB_NAME ; ".mdb already exist"</P>
<P>        Exit Sub</P>
<P>    Else</P>
<P>        ' Create a new Access database</P>
<P>        Set pOutWorkspaceFactory = New AccessWorkspaceFactory</P>
<P>        Set pOutWorkspaceName = pOutWorkspaceFactory.Create(sDataPath, MDB_NAME, Nothing, 0)</P>
<P>        ' create a new feature datset name object for the output Access feature dataset, call</P>
<P>        ' it "World"</P>
<P>        Set pOutFeatureDSName = New FeatureDatasetName</P>
<P>        Set pOutDSName = pOutFeatureDSName</P>
<P>        Set pOutDSName.WorkspaceName = pOutWorkspaceName</P>
<P>        pOutDSName.Name = F_DS_NAME</P>
<P>        ' Get the name object for the input shapefile workspace</P>
<P>        Set pInWorkspaceName = New WorkspaceName</P>
<P>        pInWorkspaceName.PathName = sDataPath</P>
<P>        pInWorkspaceName.WorkspaceFactoryProgID = _</P>
<P> "esriCore.ShapefileWorkspaceFactory.1"</P>
<P>        Set pInFeatureClassName = New FeatureClassName</P>
<P>        Set pInDatasetName = pInFeatureClassName</P>
<P>        pInDatasetName.Name = SHAPE_NAME</P>
<P>        Set pInDatasetName.WorkspaceName = pInWorkspaceName</P>
<P>        ' Create the new output FeatureClass name object that will be passed</P>
<P>        '   into the conversion function</P>
<P>        Set pOutFeatureClassName = New FeatureClassName</P>
<P>        Set pOutDatasetName = pOutFeatureClassName</P>
<P>        ' Set the new FeatureClass name to be the same as the input FeatureClass name</P>
<P>        pOutDatasetName.Name = pInDatasetName.Name</P>
<P>        ' Open the input Shapefile FeatureClass object, so that we can get its fields</P>
<P>        Set pName = pInFeatureClassName</P>
<P>        Set pInFeatureClass = pName.Open</P>
<P>        ' Get the fields for the input feature class and run them through</P>
<P>        '   field checker to make sure there are no illegal or duplicate field names</P>
<P>        Set pInFields = pInFeatureClass.Fields</P>
<P>        Set pFieldChecker = New FieldChecker</P>
<P>        pFieldChecker.Validate pInFields, Nothing, pOutFields</P>
<P>        ' Loop through the output fields to find the geometry field</P>
<P>        For iCounter = 0 To pOutFields.FieldCount</P>
<P>            If pOutFields.Field(iCounter).Type = esriFieldTypeGeometry Then</P>
<P>                Set pGeoField = pOutFields.Field(iCounter)</P>
<P>                Exit For</P>
<P>            End If</P>
<P>        Next iCounter</P>
<P>        ' Get the geometry field's geometry definition</P>
<P>        Set pOutGeometryDef = pGeoField.GeometryDef</P>
<P>        ' Give the geometry definition a spatial index grid count and grid size</P>
<P>        Set pOutGeometryDefEdit = pOutGeometryDef</P>
<P>        pOutGeometryDefEdit.GridCount = 1</P>
<P>        pOutGeometryDefEdit.GridSize(0) = 1500000</P>
<P>        ' Now use IFeatureDataConverter::Convert to create the output FeatureDataset and</P>
<P>        '   FeatureClass.</P>
<P>        Set pShpToFeatClsConverter = New FeatureDataConverter</P>
<P>        pShpToFeatClsConverter.ConvertFeatureClass pInFeatureClassName, Nothing, _pOutFeatureDSName, pOutFeatureClassName, Nothing, pOutFields, "", 1000, 0<BR> MsgBox "Convert operation complete!", vbInformation</P>
<P>    End If</P>
<P>    Exit Sub</P>
<P>ErrorHandler:</P>
<P>    MsgBox Err.Description</P>
<P>End Sub</P>