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

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

90楼^#

发布于：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麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

91楼^#

发布于：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麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

92楼^#

发布于：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麦田守望者，期待与您交流。

举报回复喜欢评分

木白林

路人甲

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

加关注写私信

93楼^#

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

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

心情卡片一起分享...

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

94楼^#

发布于：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>

GIS麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

95楼^#

发布于：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麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

96楼^#

发布于：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麦田守望者，期待与您交流。

举报回复喜欢评分

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

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

98楼^#

发布于：2005-07-26 11:02

如何连接栅格文件
 
本例实现的是如何在当前激活的Map中添加一个栅格文件。
 l 要点
创建一个IrasterLayer接口对象，使用IRasterLayer.CreateFromFilePath方法加载一个Raster文件，最后用IMap.AddLayer方法将IRasterLayer添加到当前激活的Map中。
主要用到IRasterLayer接口。
 l 程序说明
函数AddRasterFile将路径sFilePath下的栅格文件sFileName添加到当前激活的Map中。
 l 代码

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

<TR>
<TD vAlign=top width=535 height=75>
Private Sub AddRasterFile(sFilePath As String, sFileName As String)
 'sFileName: the filename of the raster dataset 'sPath: the directory where the raster dataset resides
 Dim pRasterLy As IRasterLayer Dim pMxDoc As IMxDocument Dim pMap As IMap Dim sRasterFile As String
On Error GoTo ErrorHandler:
 sRasterFile = Dir(sFilePath ; sFileName) If (sRasterFile = "") Then MsgBox ("文件不存在") Exit Sub End If
 'Create a raster layer Set pRasterLy = New RasterLayer
 'This is only one of the three ways to create a RasterLayer object. 'If there is already a Raster or RasterDataset object, then 'method CreateFromDataset or CreateFromRaster can be used. pRasterLy.CreateFromFilePath sFilePath ; sFileName
 'Add the raster layer to ArcMap Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap pMap.AddLayer pRasterLy pMxDoc.ActiveView.Refresh
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub
Private Sub UIButtonControl1_Click()
 Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
 Set pVBProject = ThisDocument.VBProject AddRasterFile pVBProject.FileName ; "\..\..\..\.." ; "\data\", "photo.tif"
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub</TD></TR></TABLE>

GIS麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

99楼^#

发布于：2005-07-26 11:02

如何连接Coverage文件
本例实现的是如何在当前激活的Map中连接一个Coverage文件。
 l 要点
使用ArcInfoWorkspaceFactory类实现IWorkSpaceFactory接口对象，用IWorkspaceFactory.Open方法打开一个Workspace，并获得Dataset对象。由于此时的Dataset对象可能有多个Coverage文件，所以要获得IEnumDataset接口对象，通过IEnumDataset.Next方法获得一个Coverage文件，并将其所有的FeatureClass放在IFeatureClassContainer对象中。最后通过IFeatureClassContainer.Class方法获得IFeatureClass接口实例，用IMap.AddLayer方法将要连接的Coverage文件的所有FeatureClass加载到当前激活的Map中。
主要用到IWorkspaceFactory接口，IWorkspace接口，IPropertySet接口，IDataset接口，IEnumDataset接口，IFeatureClassContainer接口。
 l 程序说明
函数ConnectCoverageFile将sFilePath指定的ArcInfo Workspace中的名称和sFileName相同的Coverage文件加载到当前激活的Map中。
 l 代码

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

<TR>
<TD vAlign=top width=535 height=75>
Private Sub ConnectCoverageFile(ByVal sFilePath As String, ByVal sFileName As String)
 Dim pWorkspace As IWorkspace Dim pWorkspaceFactory As IWorkspaceFactory Dim pPropertySet As IPropertySet Dim pDataset As IDataset Dim pEnumDataset As IEnumDataset Dim pFeatureClassC As IFeatureClassContainer Dim pFeatureLayer As IFeatureLayer Dim pMxDocument As IMxDocument Dim pMap As IMap Dim nNumber As Integer Dim sWorkspace As String
On Error GoTo ErrorHandler:
 sWorkspace = Dir(sFilePath, vbDirectory) If (sWorkspace = "") Then MsgBox ("文件不存在") Exit Sub End If
 Set pWorkspaceFactory = New ArcInfoWorkspaceFactory Set pPropertySet = New PropertySet
 'canada is an arcinfoworkspace pPropertySet.SetProperty "DATABASE", sFilePath
 'pWorkSp is a pointer to the IArcInfoWorkspace Set pWorkspace = pWorkspaceFactory.Open(pPropertySet, 0)
 'now get to dataset objects using Idataset Set pDataset = pWorkspace
 'use enum to get datasets Set pEnumDataset = pDataset.Subsets
 pEnumDataset.Reset
 'use FeatureClassContainer to get datasets Set pFeatureClassC = pEnumDataset.Next
 Do While Not pFeatureClassC Is Nothing Set pDataset = pFeatureClassC If (pDataset.Name <> sFileName) Then Set pFeatureClassC = pEnumDataset.Next Else Exit Do End If Loop
 'add FeatureClassContainer to map If (pFeatureClassC Is Nothing) Then MsgBox ("文件不存在") Else nNumber = 0 Set pMxDocument = ThisDocument Set pMap = pMxDocument.FocusMap Do While nNumber < pFeatureClassC.ClassCount Set pFeatureLayer = New FeatureLayer Set pFeatureLayer.FeatureClass = pFeatureClassC.Class(nNumber) pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName nNumber = nNumber + 1 pMap.AddLayer pFeatureLayer Loop 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 ConnectCoverageFile pVBProject.FileName ; "\..\..\..\.." ; "\data\canada", "canada"
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub</TD></TR></TABLE>

GIS麦田守望者，期待与您交流。

举报回复喜欢评分

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