Public Function openDataSet(ByVal pMap As IMap) As Boolean
'On Error GoTo errH
Dim pGxDialog As IGxDialog
Set pGxDialog = New GxDialog
pGxDialog.AllowMultiSelect = True
pGxDialog.Title = "选择要素数据集"
pGxDialog.ButtonCaption = "添加"
Dim pGxFilter As IGxObjectFilter
Set pGxFilter = New GxFilterFeatureDatasetsAndFeatureClasses
Set pGxDialog.ObjectFilter = pGxFilter
Dim pGxObjects As IEnumGxObject
pGxDialog.DoModalOpen 0, pGxObjects
If pGxObjects Is Nothing Then
MsgBox "没有添加数据"
Exit Function
End If
pGxObjects.Reset
Dim pFeatLyr As IFeatureLayer
Dim pGxDataset As IGxDataset
Set pGxDataset = pGxObjects.Next
Do Until pGxDataset Is Nothing
If TypeOf pGxDataset.Dataset Is IFeatureClass Then
Dim pFC As IFeatureClass
Set pFC = pGxDataset.Dataset
If pFC.FeatureType = esriFTAnnotation Then
Set pFeatLyr = New FDOGraphicsLayer
Else
Set pFeatLyr = New FeatureLayer
End If
Set pFeatLyr.FeatureClass = pGxDataset.Dataset
pFeatLyr.Name = pFeatLyr.FeatureClass.AliasName
pMap.AddLayer pFeatLyr
ElseIf TypeOf pGxDataset.Dataset Is IFeatureDataset Then
Dim pEnumDataset As IEnumDataset
Set pEnumDataset = pGxDataset.Dataset.Subsets
pEnumDataset.Reset
Dim pDataSet As IDataset
Set pDataSet = pEnumDataset.Next
Do While Not pDataSet Is Nothing
Set pFC = pDataSet
'如果载入的要素类为标注要素类，则产生特殊图层
If pFC.FeatureType = esriFTAnnotation Then
Set pFeatLyr = New FDOGraphicsLayer
Else
Set pFeatLyr = New FeatureLayer
End If
Set pFeatLyr.FeatureClass = pFC
pFeatLyr.Name = pFC.AliasName
Debug.Print pFeatLyr.Name
pMap.AddLayer pFeatLyr
Set pFeatLyr = Nothing
Set pDataSet = pEnumDataset.Next
Loop
End If
Set pGxDataset = pGxObjects.Next
Loop
openDataSet = True
errh:
'openDataSet = False
'MsgBox "打开图层发生错误，错误原因：" & vbCrLf & Err.Description
End Function
|
（本文已被浏览 次） | | |
相关评论
