ESRI ArcGIS应用与开发 [帝国首发]ArcGIS开发教材,0830更新,提问前请先看||做专业的GIS技术交流论坛

assa 路人甲注册日期2004-08-04 发帖数8 QQ 铜币126枚威望0点贡献值0点银元0个加关注写私信	20楼^# 发布于：2005-07-26 21:34 <P>支持支持，能回复吗？</P>
	举报回复(0) 喜欢(0) 评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

21楼^#

发布于：2005-07-27 13:09

如何创建Shape文件
本例实现的是如何创建一个Shape文件。
 l 要点
首先创建新IField接口实例，生成新字段，并获得该实例的IFieldEdit接口对象，用FieldsEdit的AddField方法将新字段加入到IFields接口对象中，最后用IFeatureWorkspace的CreateFeatureClass方法生成新的Shape文件
主要用到IFeatureWorkspace接口，IWorkspaceFactory接口，IFieldsEdit接口，IFieldEdit接口，IFeatureClass接口。
 l 程序说明
函数CreatShapeFile根据输入的文件路径和文件名，创建Shape文件。
 l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD vAlign=top width=535 height=75>
Private Sub CreatShapeFile(ByVal sFilePath As String, ByVal sFileName As String)
 Dim pFeatureWorkspace As IFeatureWorkspace Dim pWorkspaceFactory As IWorkspaceFactory Dim pFields As IFields Dim pFieldsEdit As IFieldsEdit Dim pField As IField Dim pFieldEdit As IFieldEdit Dim pGeometryDef As IGeometryDef Dim pGeometryDefEdit As IGeometryDefEdit Dim pFeatClass As IFeatureClass Dim sShapeFieldName As String Dim sNewShapeFileName As String
On Error GoTo ErrorHandler:
 sNewShapeFileName = Dir(sFilePath ; sFileName ; ".shp") If (sNewShapeFileName <> "") Then MsgBox ("文件已经存在") Exit Sub End If
 sShapeFieldName = "Shape" 'Open the folder to contain the shapefile as a workspace Set pWorkspaceFactory = New ShapefileWorkspaceFactory Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0)
 'Set up a simple fields collection Set pFields = New esriCore.Fields Set pFieldsEdit = pFields
 'Make the shape field 'it will need a geometry definition, with a spatial reference Set pField = New esriCore.Field Set pFieldEdit = pField pFieldEdit.Name = sShapeFieldName pFieldEdit.Type = esriFieldTypeGeometry Set pGeometryDef = New GeometryDef Set pGeometryDefEdit = pGeometryDef With pGeometryDefEdit .GeometryType = esriGeometryPolygon Set .SpatialReference = New UnknownCoordinateSystem End With Set pFieldEdit.GeometryDef = pGeometryDef pFieldsEdit.AddField pField
 'Add others miscellaneous text field Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit .Name = "SmallInteger" .Type = esriFieldTypeSmallInteger End With pFieldsEdit.AddField pField
 Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit .Name = "Integer" .Type = esriFieldTypeInteger End With
 pFieldsEdit.AddField pField
 Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit .Name = "Single" .Type = esriFieldTypeSingle End With
 pFieldsEdit.AddField pField
 Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit .Precision = 5 .Scale = 5 .Name = "Double" .Type = esriFieldTypeDouble End With
 pFieldsEdit.AddField pField
 Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit .Length = 30 .Name = "String" .Type = esriFieldTypeString End With
 pFieldsEdit.AddField pField
 Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit .Name = "Date" .Type = esriFieldTypeDate End With
 pFieldsEdit.AddField pField 
 'Create the shapefile '(some parameters apply to geodatabase options and can be defaulted as Nothing) Set pFeatClass = pFeatureWorkspace.CreateFeatureClass _ (sFileName, pFields, Nothing, Nothing, _ esriFTSimple, sShapeFieldName, "")
 sNewShapeFileName = Dir(sFilePath ; "\MyShapeFile.shp")
 If (sNewShapeFileName = "") Then MsgBox ("Build Success") Else MsgBox ("Build Fail") End If
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub
Private Sub UIButtonControl1_Click()
 Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
 Set pVBProject = ThisDocument.VBProject 'Dont include .shp extension CreatShapeFile pVBProject.FileName ; "\..\..\..\.." ; "\data\", "MyShapeFile"
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub
Private Sub UIButtonControl1_Click()
 Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
 Set pVBProject = ThisDocument.VBProject 'Dont include .shp extension CreatShapeFile pVBProject.FileName ; "\..\..\..\.." ; "\data\", "MyShapeFile"
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub</TD></TR></TABLE>

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

22楼^#

发布于：2005-07-27 13:10

如何创建DBF文件
本例要实现的是如何创建一个单独的DBF文件。
l 要点
首先设定DBF文件的字段个数，再创建新的IField对象，生成新字段，设置其属性，再加入到IFields对象中，最后用IFeatureWorkspace.CreateTable方法创建一个新的DBF文件并返回ITable对象。
主要用到IField接口，IFieldEdit接口，IFields接口，IFieldsEdit接口。
l 程序说明
函数CreateDBF根据输入的路径和文件名创建一个DBF文件并返回一个ITable对象。
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD vAlign=top width=535 height=75>
Private Function CreateDBF (sFilePath As String, sFileName As String) As ITable
'createDBF: simple function to create a DBASE file.
'note: the name of the DBASE file should not contain the .dbf extension
On Error GoTo ErrorHandler:
 Dim pFeatureWorkspace As IFeatureWorkspace
 Dim pWorkspaceFactory As IWorkspaceFactory
 Dim FileFolder As New Scripting.FileSystemObject
 Dim pFieldsEdit As esriCore.IFieldsEdit
 Dim pFieldEdit As esriCore.IFieldEdit
 Dim pFields As IFields
 Dim pField As IField
 Dim sDir As String
 'Open the Workspace
 Set pWorkspaceFactory = New ShapefileWorkspaceFactory
 If Not FileFolder.FolderExists(sFilePath) Then
 MsgBox "路径不存在" ; vbCr ; sFilePath
 Exit Function
 End If
 sDir = Dir(sFilePath ; sFileName ; ".dbf")
 If (sDir <> "") Then
 MsgBox ("文件已存在")
 Exit Function
 End If
 Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0)
 'if a fields collection is not passed in then create one
 'create the fields used by our object
 Set pFields = New esriCore.Fields
 Set pFieldsEdit = pFields
 pFieldsEdit.FieldCount = 6
 'Create text Fields
 Set pField = New Field
 Set pFieldEdit = pField
 With pFieldEdit
 .Name = "SmallInteger"
 .Type = esriFieldTypeSmallInteger
 End With
 Set pFieldsEdit.Field(0) = pField
 Set pField = New Field
 Set pFieldEdit = pField
 With pFieldEdit
 .Name = "Integer"
 .Type = esriFieldTypeInteger
 End With
 Set pFieldsEdit.Field(1) = pField
 Set pField = New Field
 Set pFieldEdit = pField
 With pFieldEdit
 .Name = "Single"
 .Type = esriFieldTypeSingle
 End With
 Set pFieldsEdit.Field(2) = pField
 Set pField = New Field
 Set pFieldEdit = pField
 With pFieldEdit
 .Precision = 5
 .Scale = 5
 .Name = "Double"
 .Type = esriFieldTypeDouble
 End With
 Set pFieldsEdit.Field(3) = pField
 Set pField = New Field
 Set pFieldEdit = pField
 With pFieldEdit
 .Length = 30
 .Name = "String"
 .Type = esriFieldTypeString
 End With
 Set pFieldsEdit.Field(4) = pField
 Set pField = New Field
 Set pFieldEdit = pField
 With pFieldEdit
 .Name = "Date"
 .Type = esriFieldTypeDate
 End With
 Set pFieldsEdit.Field(5) = pField
 Set createDBF = pFeatureWorkspace.CreateTable(sFileName, pFields, Nothing, Nothing, "")
 sDir = Dir(sFilePath ; sFileName ; ".dbf")
 If (sDir <> "") Then
 MsgBox ("Build　Success")
 Else
 MsgBox ("Build Fail")
 End If
 Exit Function
ErrorHandler:
 MsgBox Err.Description
End Function
Private Sub UIButtonControl1_Click()
 Dim pVBProject As VBProject
 Dim pTable As ITable
On Error GoTo ErrorHandler:
 Set pVBProject = ThisDocument.VBProject
 'Dont include .dbf extension
 Set pTable = CreateDBF (pVBProject.FileName ; "\..\..\..\.." ; "\data\", "MyDBFFile")
 Exit Sub
ErrorHandler:
 MsgBox Err.Description
End Sub</TD></TR></TABLE>

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

23楼^#

发布于：2005-07-27 13:11

如何创建GeoDataBase文件
本例要实现的是如何创建一个GeoDataBase文件。
l 要点
定义IWorkspaceFactory接口对象，并用esriCore. AccessWorkspaceFactory类来实现，再调用IWorkspaceFactory.Create方法创建一个GeoDataBase文件。
主要用到了IWorkspaceFactory接口。
l 程序说明
函数CreateAccessWorkspace根据要创建的GeoDataBase文件所在路径sFilePath和文件名sFileName创建GeoDataBase文件。
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD vAlign=top width=535 height=75>
Private Function CreateAccessWorkspace(sFilePath As String, sFileName As String)
 Dim pWorkspaceFactory As IWorkspaceFactory
 Dim sDir As String
On Error GoTo ErrorHandler:
 
 sDir = Dir(sFilePath ; sFileName ; ".mdb")
 If (sDir <> "") Then
 MsgBox ("文件已存在")
 Exit Function
 End If
 
 'create the Access Workspace factory
 Set pWorkspaceFactory = New esriCore.AccessWorkspaceFactory
 pWorkspaceFactory.Create sFilePath, sFileName, Nothing, 0
 
 sDir = Dir(sFilePath ; sFileName ; ".mdb")
 If (sDir <> "") Then
 MsgBox ("Build Success")
 Else
 MsgBox ("Build Fail")
 End If
 
 Exit Function
ErrorHandler:
 MsgBox Err.Description
End Function
 
Private Sub UIButtonControl1_Click()
 Dim pVBProject As VBProject
 
On Error GoTo ErrorHandler:
 Set pVBProject = ThisDocument.VBProject
 
 'Dont include .mdb extension
 CreateAccessWorkspace pVBProject.FileName ; "\..\..\..\.." ; "\data\", "MyGEODataFile"
 Exit Sub
ErrorHandler:
 MsgBox Err.Description
End Sub</TD></TR></TABLE>

举报回复喜欢评分

木白林

路人甲

注册日期2004-03-19
发帖数319
QQ
铜币824枚
威望0点
贡献值0点
银元0个

加关注写私信

24楼^#

发布于：2005-07-27 15:29

这么好的帖子不顶对不起啊

心情卡片一起分享...

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

25楼^#

发布于：2005-07-30 15:16

如何创建Coverage文件
本例要实现的是如何创建一个Coverage文件。
l 要点
首先为IWorkspaceFactory接口创建一个ArcInfoWorkspaceFactory的实例，然后根据路径sWorkspacePath使用IWorkspaceFactory.Create方法和IWorkspaceFactory.Open方法，获得一个名为sWorkspaceName的ArcInfo Workspace，最后使用IArcInfoWorkspace. CreateCoverage方法创建一个名为sFileName的Coverage文件。
主要用到IWorkspaceFactory接口，IArcInfoWorkspace接口和IPropertySet接口。
l 程序说明
函数CreateCoverageFile根据路径sWorkspacePath和名称sWorkspaceName创建一个ArcInfo Workspace，再在其中创建名为sFileName的Coverage文件。
l 代码

Private Sub CreateCoverageFile(ByVal sWorkspacePath As String,ByVal sWorkspaceName As String, ByVal sFileName As String)
 Dim pWorkspaceFactory As IWorkspaceFactory
 Dim pArcInfoWorkspace As IArcInfoWorkspace
 Dim pPropertySet As IPropertySet
 Dim pFeatureDataset As IFeatureDataset
 Dim sTemplateCoverage As String
 Dim sCoverageFile As String On Error GoTo ErrorHandler:
sCoverageFile = Dir(sWorkspacePath ; "\" ; sWorkspaceName ; "\" ; sFileName, vbDirectory)
 If (sCoverageFile <> "") Then
 MsgBox ("文件已经存在")
 Exit Sub
 End If
 Set pFeatureDataset = Nothing
 Set pPropertySet = New PropertySet
 pPropertySet.SetProperty "SERVER", sWorkspaceName
 Set pWorkspaceFactory = New ArcInfoWorkspaceFactory
 'create an arcinfoworkspace
 pWorkspaceFactory.Create sWorkspacePath, sWorkspaceName, pPropertySet, 0
 pPropertySet.SetProperty "DATABASE", sWorkspacePath ; "\" ; sWorkspaceName
 'pArcInfoWorkspace is a pointer to the IArcInfoWorkspace
 Set pArcInfoWorkspace = pWorkspaceFactory.Open(pPropertySet, 0)
 'create a coverage without a template
 Set pFeatureDataset = pArcInfoWorkspace.CreateCoverage(sFileName, "", _esriCoveragePrecisionDouble) ' or use the methods on iarcinfoworkspace
' sTemplateCoverage = "C:\arcgis\arcexe83\arcobjects developer kit\samples\data\canada\canada"
' Set pFeatureDataset = pArcInfoWorkspace.CreateCoverage(sFileName, sTemplateCoverage, _esriCoveragePrecisionDouble)
 If (pFeatureDataset Is Nothing) Then
 MsgBox ("Build Success")
 Else
 MsgBox ("Build Fail")
 End If
 Exit Sub
ErrorHandler:
 MsgBox Err.Description
End Sub
Private Sub UIButtonControl1_Click()
 Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
 Set pVBProject = ThisDocument.VBProject
 CreateCoverageFile pVBProject.FileName ; "\..\..\..\.." ; "\data", _
 "MyArcInfoWorkspace", "MyCoverFile"
 Exit Sub
ErrorHandler:
 MsgBox Err.Description
End Sub

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

26楼^#

发布于：2005-07-30 15:17

如何建立文件连接(Join / Link)
 
本例实现的是如何将地图中的一个FeatureLayer的属性表与另一个数据文件建立连接。
l 要点
首先需要定义两个ITable接口对象，分别用来获得地图中的属性表和需要连接的数据文件，再通过IMemoryRelationshipClassFactory.Open方法将两个ITable接口对象根据某个关键字段建立连接，
最后使用IDisplayRelationshipClass.DisplayRelationshipClass方法将显示该连接
主要用到IMemoryRelationshipClassFactory接口，IRelationshipClass接口和IDisplayRelationshipClass接口。
l 程序说明
函数Join是将当前激活的地图中名称为sLayerName的图层和路径为sFilePath、文件名为sFileName的文件按字段名为sFieldName的字段进行连接。
l 代码

Private Function Join(ByVal sLayerName As String, ByVal sFilePath As String, _ByVal sFileName As String, ByVal sFieldName As String) As Boolean
 Dim pMxDocument As IMxDocument Dim pMap As IMa Dim pWorkspaceFactory As IWorkspaceFactory Dim pWorkspace As IWorkspace Dim pFeatureWorkspace As IFeatureWorkspace Dim pFeatureLayer As IFeatureLayer Dim pFeatureClass As IFeatureClass Dim pPrimaryTable As ITable Dim pForeignTable As ITable Dim pDisplayTable As IDisplayTable Dim pMemoryRelationshipCF As IMemoryRelationshipClassFactory Dim pRelationshipClass As IRelationshipClass Dim pDisplayRelationshipC As IDisplayRelationshipClass Dim nNumber As Integer Dim sForeignFile As String On Error GoTo ErrorHandler:
 Join = False
 sForeignFile = Dir(sFilePath ; "\" ; sFileName)
 If (sForeignFile = "") Then
 MsgBox "The ForeignFile is not exist."
 Exit Function
 End If
 Set pWorkspaceFactory = New ShapefileWorkspaceFactory
 Set pWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0)
 Set pFeatureWorkspace = pWorkspace
 Set pForeignTable = pFeatureWorkspace.OpenTable(sFileName)
 Set pMxDocument = ThisDocument
 Set pMap = pMxDocument.FocusMap
 For nNumber = 0 To pMap.LayerCount - 1
 If pMap.Layer(nNumber).Name = sLayerName Then
 Set pFeatureLayer = pMap.Layer(nNumber)
 Exit For
 End If
 Next
 If pFeatureLayer Is Nothing Then
 MsgBox "No Layer's Name is " ; sLayerName
 Exit Function
 End If
 Set pDisplayTable = pFeatureLayer
 Set pFeatureClass = pDisplayTable.DisplayTable
 Set pPrimaryTable = pFeatureClass
 Set pMemoryRelationshipCF = New MemoryRelationshipClassFactory
 Set pRelationshipClass = pMemoryRelationshipCF.Open("TabletoLayer", pPrimaryTable, sFieldName, _
 pForeignTable, sFieldName, "forward", "backward", esriRelCardinalityOneToOne)
 Set pDisplayRelationshipC = pFeatureLayer
 pDisplayRelationshipC.DisplayRelationshipClass pRelationshipClass, esriLeftOuterJoin
 Join = True
 Exit Function
ErrorHandler:
 MsgBox Err.Description
End Function
Private Sub UIButtonControl1_Click()
 Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
 Set pVBProject = ThisDocument.VBProject
 Join "WorldCountries", pVBProject.FileName ; "\..\..\..\.." ; "\data", "Continents.dbf", "FID"
 Exit Sub
ErrorHandler:
 MsgBox Err.Description
End Sub

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

27楼^#

发布于：2005-07-30 15:18

如何浏览纪录(属性查询)
 
本例实现的是如何按照给定的查询要求，找出满足要求的记录。
l 要点
创建IQueryFilter接口对象，设置IQueryFilter.WhereClause属性为属性查询条件，使用IFeatureClass.Search方法进行查询，返回ICursor接口对象
主要用到了IFeatureClass接口、IFeature接口、IFeatureCursor接口和IQueryFilter接口。
l 程序说明
函数SelectFeatures在当前激活的Map的第一个图层中查出"FID < 2"的所有记录。
l 代码
<TABLE height=43 width=541 align=center border=0>

<TR>
<TD vAlign=top width=535 height=75>
Private Sub SelectFeatures()
 Dim pMxDocument As IMxDocument
 Dim pMap As IMap
 Dim pFeatureLayer As IFeatureLayer
 Dim pFeatureClass As IFeatureClass
 Dim pFeature As IFeature
 Dim pFeatureCursor As IFeatureCursor
Dim pQueryFilter As IqueryFilter
On Error GoTo ErrorHandler:
 Set pMxDocument = ThisDocument
 Set pMap = pMxDocument.FocusMap
 If (pMap.LayerCount = 0) Then
 MsgBox ("缺少数据")
 Exit Sub
 End If
 Set pFeatureLayer = pMap.Layer(0)
 Set pFeatureClass = pFeatureLayer.FeatureClass
 Set pQueryFilter = New QueryFilter
 pQueryFilter.WhereClause = "FID < 2"
 Set pFeatureCursor = pFeatureClass.Search(pQueryFilter, False)
 Set pFeature = pFeatureCursor.NextFeature
 Do While Not pFeature Is Nothing
 'More Operations
 Set pFeature = pFeatureCursor.NextFeature
 Loop
 Exit Sub
ErrorHandler:
 MsgBox Err.Description
End Sub
Private Sub UIButtonControl1_Click()
On Error GoTo ErrorHandler:
 SelectFeatures
 Exit Sub
ErrorHandler:
 MsgBox Err.Description
End Sub</TD></TR></TABLE>

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

28楼^#

发布于：2005-07-30 15:18

如何编辑记录
本例实现的是如何修改FeatureClass中某条记录（Feature）的值。
l 要点
通过IFeatureClass.Update方法获得可修改记录的IFeatureCursor接口对象，使用IFeatureCursor.NextFeature方法获得Ifeatur接口对象，修改其属性值，通过IFeatureCursor.UpdateFeature方法提交IFeature修改内容。
主要用到IFeatureCursor接口
l 程序说明
函数OpenFeatureClass获得当前激活的Map中第一层的IFeatureClass接口对象。
函数EditFeature修改pFeatureClass中第一条记录的第七个字段的值。
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD vAlign=top width=535 height=75>
Private Function EditFeature(pFeatureClass As IFeatureClass) As Boolean
 Dim pFeature As IFeature
 Dim pFeatureCursor As IFeatureCursor
On Error GoTo ErrorHandler:
 EditFeature = False
 If (pFeatureClass Is Nothing) Then
 Exit Function
 End If
 Set pFeatureCursor = pFeatureClass.Update(Nothing, False)
 Set pFeature = pFeatureCursor.NextFeature
 If (Not pFeature Is Nothing) Then
 pFeature.Value(6) = "New Place"
 pFeatureCursor.UpdateFeature pFeature
 MsgBox ("修改成功")
 EditFeature = True
 Else
 MsgBox ("修改失败")
 End If
 Exit Function
ErrorHandler:
 MsgBox Err.Description
End Function
Private Function OpenFeatureClass() As IFeatureClass
 Dim pMxDocument As IMxDocument
 Dim pMap As IMap
 Dim pFeatureLayer As IFeatureLayer
 Dim pFeatureClass As IFeatureClass
On Error GoTo ErrorHandler:
 Set OpenFeatureClass = Nothing
 Set pMxDocument = ThisDocument
 Set pMap = pMxDocument.FocusMap
 If (pMap.LayerCount = 0) Then
 MsgBox ("缺少数据")
 Exit Function
 End If
 Set pFeatureLayer = pMap.Layer(0)
 Set pFeatureClass = pFeatureLayer.FeatureClass
 Set OpenFeatureClass = pFeatureClass
 Exit Function
ErrorHandler:
 MsgBox Err.Description
End Function
Private Sub UIButtonControl1_Click()
On Error GoTo ErrorHandler:
 Dim pFeatureClass As IFeatureClass
 Set pFeatureClass = OpenFeatureClass()
 EditFeature pFeatureClass
 Exit Sub
ErrorHandler:
 MsgBox Err.Description
End Sub</TD></TR></TABLE>

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

29楼^#

发布于：2005-07-30 15:20

如何增加记录
本例要实现的是如何在FeatureClass中新增一条记录（Feature）。
l 要点
通过IFeatureClass.Insert方法获得可插入记录的游标IFeatureCursor，然后使用IFeatureClass.CreateFeatureBuff方法获得IFeatureBuffer接口实例，使用IFeatureCursor.InsertFeature方法插入记录。
主要用到IFeatureCursor接口。
l 程序说明
函数OpenFeatureClass获得当前激活的Map中第一层的IFeatureClass接口对象。
函数InsertFeature在pFeatureClass中添加一条记录。
l 代码

Private Function InsertFeature(pFeatureClass As IFeatureClass) As Boolean
 Dim pFeatureCursor As IFeatureCursor
 Dim pFeatureBuffer As IFeatureBuffer
 Dim nFeatureNumber As Integer
On Error GoTo ErrorHandler:
 InsertFeature = False
 If (pFeatureClass Is Nothing) Then
 Exit Function
 End If
 Set pFeatureCursor = pFeatureClass.Insert(True)
 Set pFeatureBuffer = pFeatureClass.CreateFeatureBuffer
 nFeatureNumber = -1
 pFeatureBuffer.Value(6) = "Insert Land"
 nFeatureNumber = pFeatureCursor.InsertFeature(pFeatureBuffer)
 If (nFeatureNumber <> -1) Then
 MsgBox ("添加了第" ; nFeatureNumber ; "条记录")
 InsertFeature = True
 Else
 MsgBox ("添加失败")
 InsertFeature = False
 End If
 Exit Function
ErrorHandler:
 MsgBox Err.Description
End Function
Private Function OpenFeatureClass() As IFeatureClass
 Dim pMxDocument As IMxDocument
 Dim pMap As IMap
 Dim pFeatureLayer As IFeatureLayer
 Dim pFeatureClass As IFeatureClass 
On Error GoTo ErrorHandler:
 Set OpenFeatureClass = Nothing
 Set pMxDocument = ThisDocument
 Set pMap = pMxDocument.FocusMap
 If (pMap.LayerCount = 0) Then
 MsgBox ("缺少数据")
 Exit Function
 End If
 Set pFeatureLayer = pMap.Layer(0)
 Set pFeatureClass = pFeatureLayer.FeatureClass
 Set OpenFeatureClass = pFeatureClass
 Exit Function
ErrorHandler:
 MsgBox Err.Description
End Function 
Private Sub UIButtonControl1_Click()
On Error GoTo ErrorHandler:
 Dim pFeatureClass As IFeatureClass
 Set pFeatureClass = OpenFeatureClass()
 InsertFeature pFeatureClass
 Exit Sub
ErrorHandler:
 MsgBox Err.Description
End Sub

举报回复喜欢评分

您需要登录后才可以回帖，登录或者注册