Sub AggregatePolygons() Dim pMxDoc As IMxDocument Dim pMap As IMap Dim pFeatureLayer As IFeatureLayer Dim pInFeatureClass As IFeatureClass Dim pOutFeatureClass As IFeatureClass Dim sMessage As String Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap Set pFeatureLayer = pMxDoc.SelectedLayer Set pInFeatureClass = pFeatureLayer.FeatureClass '======================================================================= Dim ET As New ETGW_Core Dim sOutFileName As String Dim dAgregationDistance As Double Dim dAreaTolerance As Double dAgregationDistance = 0.04 '100 dAreaTolerance = 1 '50000 sOutFileName = "c:\00\aggregate.shp" Set pOutFeatureClass = ET.AggregatePolygons(pInFeatureClass, sOutFileName, _ dAgregationDistance, dAreaTolerance, sMessage) '======================================================================== If Not pOutFeatureClass Is Nothing Then Set pFeatureLayer = New FeatureLayer Set pFeatureLayer.FeatureClass = pOutFeatureClass pFeatureLayer.Name = pOutFeatureClass.AliasName pMap.AddLayer pFeatureLayer Else MsgBox sMessage End If End Sub