兔八哥用VB+AO写的Merge Layer程序

       ArcGIS中提供两个合并图层的工具，Append和Merge Layer.可惜，Append只能处理Coverage.而要使用Merge Layer就不得不打开庞大的ArcMap.甚至还要将合并的图层加进去。这样效率都是很低的。兔八哥写了点小东西，测试一下居然通过了，也共享给大家吧。提供Merge Layer的应用程序，没有经过严格测试和错误处理哦。此外提供Merge函数，你可以改一改，就可以处理Geodatabase（目前只写了shapefile的处理），还可以实现将某一个目录下的所有数据进行合并什么的。自己发挥一下想象吧。下载DEMO程序

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 = "esriCore.ShapefileWorkspaceFactory"

.PathName = pathMergeResult

End With

Dim pDatasetName As IDatasetName

Set pDatasetName = pFeatClassName

pDatasetName.Name = nameMergeResult

Set pDatasetName.WorkspaceName = pNewWSName

' 定义Merge参数

Dim inputArray As Iarray

Set inputArray = New esriCore.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