gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
80楼#
发布于:2005-08-02 00:24
<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>
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
木白林
路人甲
路人甲
  • 注册日期2004-03-19
  • 发帖数319
  • QQ
  • 铜币824枚
  • 威望0点
  • 贡献值0点
  • 银元0个
81楼#
发布于:2005-08-02 00:23
支持!
心情卡片 一起分享...
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
82楼#
发布于:2005-08-02 00:23
<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>
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
83楼#
发布于:2005-08-02 00:22
 如何删除字段
<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>
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
wzhipeng0117
路人甲
路人甲
  • 注册日期2005-05-05
  • 发帖数53
  • QQ
  • 铜币317枚
  • 威望0点
  • 贡献值0点
  • 银元0个
84楼#
发布于:2005-08-01 17:53
感谢总统<img src="images/post/smile/dvbbs/em01.gif" />
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
85楼#
发布于:2005-07-30 15:24
<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>
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
86楼#
发布于:2005-07-30 15:22
<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>
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
87楼#
发布于:2005-07-30 15:20
<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>
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
88楼#
发布于:2005-07-30 15:20
<P>如何增加记录</P>
<P>本例要实现的是如何在FeatureClass中新增一条记录(Feature)。</P>
<P>l   要点</P>
<P>通过IFeatureClass.Insert方法获得可插入记录的游标IFeatureCursor,然后使用IFeatureClass.CreateFeatureBuff方法获得IFeatureBuffer接口实例,使用IFeatureCursor.InsertFeature方法插入记录。</P>
<P>主要用到IFeatureCursor接口。</P>
<P>l   程序说明</P>
<P>函数OpenFeatureClass获得当前激活的Map中第一层的IFeatureClass接口对象。</P>
<P>函数InsertFeature在pFeatureClass中添加一条记录。</P>
<P>l   代码</P>
<P>
<P>Private Function InsertFeature(pFeatureClass As IFeatureClass) As Boolean</P>
<P>    Dim pFeatureCursor          As IFeatureCursor</P>
<P>    Dim pFeatureBuffer          As IFeatureBuffer</P>
<P>    Dim nFeatureNumber          As Integer</P>
<P>On Error GoTo ErrorHandler:</P>
<P>    InsertFeature = False</P>
<P>    If (pFeatureClass Is Nothing) Then</P>
<P>        Exit Function</P>
<P>    End If</P>
<P>    Set pFeatureCursor = pFeatureClass.Insert(True)</P>
<P>    Set pFeatureBuffer = pFeatureClass.CreateFeatureBuffer</P>
<P>    nFeatureNumber = -1</P>
<P>    pFeatureBuffer.Value(6) = "Insert Land"</P>
<P>    nFeatureNumber = pFeatureCursor.InsertFeature(pFeatureBuffer)</P>
<P>    If (nFeatureNumber <> -1) Then</P>
<P>        MsgBox ("添加了第" ; nFeatureNumber ; "条记录")</P>
<P>        InsertFeature = True</P>
<P>    Else</P>
<P>        MsgBox ("添加失败")</P>
<P>        InsertFeature = False</P>
<P>    End If</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>    InsertFeature pFeatureClass</P>
<P>    Exit Sub</P>
<P>ErrorHandler:</P>
<P>    MsgBox Err.Description</P>
<P>End Sub</P>
<br>
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
89楼#
发布于:2005-07-30 15:18
<P>如何编辑记录</P>
<P 17.95pt">本例实现的是如何修改FeatureClass中某条记录(Feature)的值。</P>
<P 39pt; TEXT-INDENT: -42pt">l   要点</P>
<P 17.95pt">通过IFeatureClass.Update方法获得可修改记录的IFeatureCursor接口对象,使用IFeatureCursor.NextFeature方法获得Ifeatur接口对象,修改其属性值,通过IFeatureCursor.UpdateFeature方法提交IFeature修改内容。</P>
<P 18pt">主要用到IFeatureCursor接口</P>
<P 39pt; TEXT-INDENT: -42pt">l   程序说明</P>
<P 17.95pt">函数OpenFeatureClass获得当前激活的Map中第一层的IFeatureClass接口对象。</P>
<P 17.95pt">函数EditFeature修改pFeatureClass中第一条记录的第七个字段的值。</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 EditFeature(pFeatureClass As IFeatureClass) As Boolean</P>
<P 10pt">    Dim pFeature                As IFeature</P>
<P 10pt">    Dim pFeatureCursor          As IFeatureCursor</P>
<P 10pt">On Error GoTo ErrorHandler:</P>
<P 10pt">    EditFeature = False</P>
<P 10pt">    If (pFeatureClass Is Nothing) Then</P>
<P 10pt">        Exit Function</P>
<P 10pt">    End If</P>
<P 10pt">    Set pFeatureCursor = pFeatureClass.Update(Nothing, False)</P>
<P 10pt">    Set pFeature = pFeatureCursor.NextFeature</P>
<P 10pt">    If (Not pFeature Is Nothing) Then</P>
<P 10pt">        pFeature.Value(6) = "New Place"</P>
<P 10pt">        pFeatureCursor.UpdateFeature pFeature</P>
<P 10pt">        MsgBox ("修改成功")</P>
<P 10pt">        EditFeature = True</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">    EditFeature 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>
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
游客

返回顶部