接口，ITable接口，IStandaloneTable接口和IStandaloneTableCollection接口。 ? 程序说明
函数AddTextFile通过文件路径sFilePath和文件名sFileName找到Text文件并为其创建ITable对象
函数AddDBASEFile通过文件路径sFilePath和文件名sFileName找到dBASE文件并为其创建ITable对象
函数Add_Table_TOC将ITable对象pTable加入到当前的ArcMap中。 ? 代码
Private Sub AddTextFile(ByVal sFilePath As String, ByVal sFileName As String) Dim pWorkspaceFactory As IWorkspaceFactory Dim pWorkspace As IWorkspace
Dim pFeatureWorkspace As IFeatureWorkspace Dim pTable As ITable Dim sDir As String
On Error GoTo ErrorHandler:
sDir = Dir(sFilePath & sFileName & \ If (sDir = \
MsgBox (sFileName & \文件不存在\ Exit Sub End If
'Get the ITable from the geodatabase
Set pWorkspaceFactory = New TextFileWorkspaceFactory
Set pWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0) Set pFeatureWorkspace = pWorkspace
Set pTable = pFeatureWorkspace.OpenTable(sFileName & \
'Add the table
Add_Table_TOC pTable Exit Sub ErrorHandler:
MsgBox Err.Description End Sub
Private Sub AddDBASEFile(ByVal sFilePath As String, ByVal sFileName As String) Dim pWorkspaceFactory As IWorkspaceFactory Dim pWorkspace As IWorkspace
Dim pFeatureWorkspace As IFeatureWorkspace Dim pTable As ITable
On Error GoTo ErrorHandler:
'Get the ITable from the geodatabase
Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Set pWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0) Set pFeatureWorkspace = pWorkspace
-31-
Set pTable = pFeatureWorkspace.OpenTable(sFileName) 'Add the table Add_Table_TOC pTable Exit Sub ErrorHandler:
MsgBox Err.Description End Sub
Private Sub Add_Table_TOC(pTable As ITable)
Dim pDoc As IMxDocument Dim pMap As IMap
Dim pStandaloneTable As IStandaloneTable
Dim pStandaloneTableC As IStandaloneTableCollection
On Error GoTo ErrorHandler: Set pDoc = ThisDocument Set pMap = pDoc.FocusMap
'Create a new standalone table and add it 'to the collection of the focus map
Set pStandaloneTable = New StandaloneTable Set pStandaloneTable.Table = pTable Set pStandaloneTableC = pMap
pStandaloneTableC.AddStandaloneTable pStandaloneTable
'Refresh the TOC pDoc.UpdateContents Exit Sub ErrorHandler:
MsgBox Err.Description End Sub
Private Sub UIButtonControl1_Click()
Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
Set pVBProject = ThisDocument.VBProject
'Add text file to ArcMap. Dont include .txt extension
AddTextFile pVBProject.FileName & \ 'Add dBASE file to ArcMap
AddDBASEFile pVBProject.FileName & \ Exit Sub ErrorHandler:
MsgBox Err.Description End Sub
1.3.3. 如何连接GeoDataBase文件
本例实现的是连接一个GeoDataBase文件，并在ArcMap中加载该GeoDataBase文件的一个表。
-32-
? 要点
定义IWorkspaceFactory接口对象，使用AccessWorkspaceFactory类实现之。再创建IFeatureLayer接口对象，用IFeatureWorkspace.OpenFeatureClass方法加载GeoDataBase文件的一个表到IFeatureLayer.FeatureClass对象中。最后用IMap.AddLayer方法将新层添加到当前地图。
使用接口有：IWorkspaceFacktory接口、IFeatureWorkspace接口、IFeatureLayer接口和IMap接口。 ? 程序说明
函数OpenGeoDataBaseFile根据输入的GeoDataBase文件的路径（带文件名及后缀）sAllFileName连接GeoDataBase文件，再根据输入的GeoDataBase文件中的某表表名sTableName加载该表到激活的Map中去。 ? 代码
Private Sub OpenGeoDataBaseFile(ByVal sAllFileName As String, ByVal sTableName As String) Dim pWorkspaceFactory As IWorkspaceFactory Dim pFeatureWorkspace As IFeatureWorkspace Dim pFeatureLayer As IFeatureLayer Dim pMxDocument As IMxDocument Dim pMap As IMap Dim sDir As String
On Error GoTo ErrorHandler: sDir = Dir(sAllFileName) If (sDir = \
MsgBox (\文件不存在\ Exit Sub End If
'Create a new AccessWorkspaceFactory object and open a GeoDataBaseFile Set pWorkspaceFactory = New AccessWorkspaceFactory
Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sAllFileName, 0)
'Create a new FeatureLayer and assign a Table to it Set pFeatureLayer = New FeatureLayer
Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass(sTableName) pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName
'Add the FeatureLayer to the focus map Set pMxDocument = Application.Document Set pMap = pMxDocument.FocusMap pMap.AddLayer pFeatureLayer Exit Sub ErrorHandler:
MsgBox Err.Description End Sub
Private Sub UIButtonControl1_Click()
Dim pVBProject As VBProject On Error GoTo ErrorHandler:
-33-
Set pVBProject = ThisDocument.VBProject
OpenGeoDataBaseFile pVBProject.FileName & \& \\ Exit Sub ErrorHandler:
MsgBox Err.Description End Sub
1.3.4. 如何连接Coverage文件
本例实现的是如何在当前激活的Map中连接一个Coverage文件。 ? 要点
使用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接口。 ? 程序说明
函数ConnectCoverageFile将sFilePath指定的ArcInfo Workspace中的名称和sFileName相同的Coverage文件加载到当前激活的Map中。 ? 代码
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:
-34-
sWorkspace = Dir(sFilePath, vbDirectory) If (sWorkspace = \ MsgBox (\文件不存在\ Exit Sub End If
Set pWorkspaceFactory = New ArcInfoWorkspaceFactory Set pPropertySet = New PropertySet 'canada is an arcinfoworkspace
pPropertySet.SetProperty \ '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 & \ Exit Sub ErrorHandler:
-35-