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> |
|
|
81楼#
发布于:2005-08-02 00:23
支持!
|
|
|
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> |
|
|
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> |
|
|
84楼#
发布于:2005-08-01 17:53
感谢总统<img src="images/post/smile/dvbbs/em01.gif" />
|
|
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> |
|
|
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> |
|
|
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> |
|
|
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> |
|
|
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> |
|
|