mod_tools.bas

ArcEngine 这是基于AE组件的源代码

Attribute VB_Name = "Mod_Tools"
Public Function Merge(pathLayer1 As String, pathLayer2 As String, pathMergeResult As String, _
nameLayer1 As String, nameLayer2 As String, nameMergeResult As String)
        ' 分别读取图层一,图层二到FeatureClass和Table中
        Dim pWorkspaceFactory As IWorkspaceFactory
        Dim pWorkspace1 As IFeatureWorkspace
        Dim pWorkspace2 As IFeatureWorkspace
        
        Dim pFirstFeatClass As IFeatureClass
        Dim pSecondFeatClass As IFeatureClass
        Dim pFirstTable As ITable
        Dim pSecondTable As ITable
        
        Dim pFeatLayer1 As IFeatureLayer
        Set pFeatLayer1 = New FeatureLayer
        
        Dim pFeatLayer2 As IFeatureLayer
        Set pFeatLayer2 = New FeatureLayer
        
        Set pWorkspaceFactory = New ShapefileWorkspaceFactory
        Set pWorkspace1 = pWorkspaceFactory.OpenFromFile(pathLayer1, 0)
        Set pWorkspace2 = pWorkspaceFactory.OpenFromFile(pathLayer2, 0)
        
        Set pFirstFeatClass = pWorkspace1.OpenFeatureClass(nameLayer1)
        Set pSecondFeatClass = pWorkspace2.OpenFeatureClass(nameLayer2)
        
        Set pFeatLayer1.FeatureClass = pFirstFeatClass
        Set pFirstTable = pFeatLayer1
        Set pFeatLayer2.FeatureClass = pSecondFeatClass
        Set pSecondTable = pFeatLayer2
        
        ' 检查错误
        If pFirstTable Is Nothing Then
          MsgBox "Table QI failed"
          Exit Function
        End If
        
        If pSecondTable Is Nothing Then
          MsgBox "Table QI failed"
          Exit Function
        End If
        
        ' 定义输出要素类名称和shape类型
        Dim pFeatClassName As IFeatureClassName
        Set pFeatClassName = New FeatureClassName
        
        With pFeatClassName
        .FeatureType = esriFTSimple
        .ShapeFieldName = "Shape"
        .ShapeType = pFirstFeatClass.ShapeType
        End With
        
        ' 定义输出shapefile位置与名称
        Dim pNewWSName As IWorkspaceName
        Set pNewWSName = New WorkspaceName
        
        With pNewWSName
        .WorkspaceFactoryProgID = "esriDataSourcesFile.ShapefileWorkspaceFactory"
        .PathName = pathMergeResult
        End With
        
        Dim pDatasetName As IDatasetName
        Set pDatasetName = pFeatClassName
        pDatasetName.name = nameMergeResult
        
        Set pDatasetName.WorkspaceName = pNewWSName
        
        ' 定义Merge参数
        Dim inputArray As IArray
        'se inputArray = New array
             
        inputArray.Add pFirstTable
        inputArray.Add pSecondTable
        
        ' 进行Merge操作
        Dim pBGP As IBasicGeoprocessor
        Set pBGP = New BasicGeoprocessor
        Dim pOutputFeatClass As IFeatureClass
        Set pOutputFeatClass = pBGP.Merge(inputArray, pFirstTable, pFeatClassName)


End Function

'Public Function SDECopyFeature(ByVal strFeatureName As String, _
'                                        ByRef pFWS As IFeatureWorkspace, _
'                                        ByVal strMDBName As String, _
'                                        ByVal FeatureType As Integer) As Long
'        On Error GoTo Error_h
'        ' Connect to MDB
'        Dim pWorkspaceFactory As IWorkspaceFactory
'        Set pWorkspaceFactory = New AccessWorkspaceFactory
'
'        Dim pAccessWorkSpace As IFeatureWorkspace
'        Set pAccessWorkSpace = pWorkspaceFactory.OpenFromFile(strMDBName, 0)
'
'        Dim pSDEFeatureClass As IFeatureClass
'        Set pSDEFeatureClass = pFWS.OpenFeatureClass(strFeatureName)
'
'        If FeatureType = 0 Then ' Point
'            SDECreatePointFeatureClass strFeatureName, pAccessWorkSpace
'        Else                ' Polygon
'            SDECreatePolygonFeatureClass strFeatureName, pAccessWorkSpace, strFeatureName, pFWS
'        End If
'
'        Dim pFeatureCursor As IFeatureCursor
'        Set pFeatureCursor = pSDEFeatureClass.Search(Nothing, False)
'
'        Dim pAccessFeatureClass As IFeatureClass
'        Set pAccessFeatureClass = pAccessWorkSpace.OpenFeatureClass(strFeatureName)
'
'        Dim pSDEFeat As iFeature
'        Set pSDEFeat = pFeatureCursor.NextFeature
'
'        Dim pAccessFeat As iFeature
'        Dim pos As Long
'        Dim count As Long
'        Dim i As Long
'        While Not pSDEFeat Is Nothing
'            Set pAccessFeat = pAccessFeatureClass.CreateFeature
'            For i = 0 To pSDEFeat.Fields.FieldCount - 1
'                If pSDEFeat.Fields.Field(i).Type <> esriFieldTypeGeometry And _
'                    pSDEFeat.Fields.Field(i).Type <> esriFieldTypeOID Then
'                    pos = pAccessFeat.Fields.FindFieldByAliasName(pSDEFeat.Fields.Field(i).name)
'                    If pos <> -1 Then pAccessFeat.Value(pos) = pSDEFeat.Value(i)
'                End If
'            Next i
'            Set pAccessFeat.Shape = pSDEFeat.Shape
'            count = count + 1
'    '"　　　　Debug.Print Count
'            pAccessFeat.Store
'            Set pSDEFeat = pFeatureCursor.NextFeature
'        Wend
'
'        Set pSDEFeat = Nothing
'        SDECopyFeature = count
'        Exit Function
'Error_h:
'        MsgLogOut MeName, "SDECopyFeature()", True
'End Function
'
'