Требуется слить любое количество шейпов в один. Попробовал переделать пример Merge, да что-то не работает последняя самая главная строка.
Может кто поможет? И вообще, ход-то мыслей правильный???
Sub MergeLayers()
Dim pGxDialogLayer As IGxDialog
Dim pGxObjectLayer As IGxObject
Dim pEnumGxObjectLayer As IEnumGxObject
Dim pGxObjectFilterLayer As IGxObjectFilter
Dim anythingSelectedLayer As Boolean
Set pGxObjectFilterLayer = New GxFilterFeatureClasses
Set pGxDialogLayer = New GxDialog
pGxDialogLayer.Title = "Layers:"
pGxDialogLayer.AllowMultiSelect = True
Set pGxDialogLayer.ObjectFilter = pGxObjectFilterLayer
anythingSelectedLayer = pGxDialogLayer.DoModalOpen(Application.hWnd, pEnumGxObjectLayer)
pEnumGxObjectLayer.Reset
Dim pTable1 As ITable
Dim pTable2 As ITable
Dim pLayer As ILayer
Dim pFeatLayer As IFeatureLayer
Set pGxObjectLayer = pEnumGxObjectLayer.Next
Set pTable1 = GetTable(pGxObjectLayer)
Set pGxObjectLayer = pEnumGxObjectLayer.Next
Set pTable2 = GetTable(pGxObjectLayer)
' Error checking
If pTable1 Is Nothing Then
MsgBox "Table QI failed"
Exit Sub
End If
If pTable2 Is Nothing Then
MsgBox "Table QI failed"
Exit Sub
End If
' Define the output feature class name and shape type
Dim pFeatClassName As IFeatureClassName
Set pFeatClassName = New FeatureClassName
With pFeatClassName
.FeatureType = esriFTSimple
.ShapeFieldName = "Shape"
.ShapeType = esriGeometryPolygon 'pFirstFeatClass.ShapeType
? How to get ShapeType from pTable1
End With
' Set the output location and feature class name
Dim pNewWSName As IWorkspaceName
Set pNewWSName = New WorkspaceName
With pNewWSName
.WorkspaceFactoryProgID = "esriCore.ShapefileWorkspaceFactory.1"
.PathName = "Z:\temp"
End With
Dim pDatasetName As IDatasetName
Set pDatasetName = pFeatClassName
pDatasetName.Name = "Merge_result"
Set pDatasetName.WorkspaceName = pNewWSName
' Build the input set/array - these are the layers to be merged
Dim inputArray As IArray
Set inputArray = New esriCore.Array
inputArray.Add pTable1
inputArray.Add pTable2
' Perform the merge
Dim pBGP As IBasicGeoprocessor
Set pBGP = New BasicGeoprocessor
Dim pOutputFeatClass As IFeatureClass
Set pOutputFeatClass = pBGP.Merge(inputArray, pTable1, pFeatClassName)
End Sub
Function GetTable(pGxObject As IGxObject) As ITable
'Use name objects because they are faster than opening objects
'Coverage featureclasses will return null
On Error GoTo err:
Dim pDatasetName As IDatasetName
Dim pDSType As esriDatasetType
'Check for QI
Dim pName As IName
Dim pArcInfoTable As IArcInfoTable
Set pName = pGxObject.InternalObjectName
If TypeOf pName Is IDatasetName Then
Set pDatasetName = pName
pDSType = pDatasetName.Type
If pDSType = esriDTTable Or pDSType = esriDTFeatureClass Then
Dim pTable As ITable
Set GetTable = pName.Open
Exit Function
End If
End If
Exit Function
err:
If err.Number = 13 Then
Resume Next
End If
End Function
