Sub BatchClip()
  Dim ET As New ETGW_Core
  Dim pMxDoc As IMxDocument
  Dim pMap As IMap
  Dim sLayerName As String
  Dim pFeatureLayer As IFeatureLayer
  Dim pInFeatureClass As IFeatureClass
  Dim pOutFeatureClass As IFeatureClass
  Dim sOutFileName As String
  Dim sOutDir As String
  Dim pClipLayer As IFeatureLayer
  Dim pClipFeatureClass As IFeatureClass
  Dim dFuzzyTol As Double
  Dim lCol As New Collection
  Dim j As Integer
  On Error GoTo EH
  Set pMxDoc = ThisDocument
  Set pMap = pMxDoc.FocusMap
  Set pClipLayer = ET.GetLayer("clip_layer")
  If pClipLayer Is Nothing Then
    Exit Sub
  End If
  Set pClipFeatureClass = pClipLayer.FeatureClass
  dFuzzyTol = 0.002
  Set lCol = ET.GetFeatureLayers("All")
  If (lCol.Count = 0) Then
    MsgBox "No suitable layers in the map"
    Exit Sub
  End If
  sOutDir = "c:\00"
  For j = 1 To lCol.Count
    sLayerName = lCol.Item(j)
    If (sLayerName <> "clip_layer") Then
      sOutFileName = ET.GetUniqueShapeFileName(sOutDir, sLayerName, "_clipped")
      Set pFeatureLayer = ET.GetLayer(sLayerName)
      Set pInFeatureClass = pFeatureLayer.FeatureClass
      Set pOutFeatureClass = ET.ClipIt(pInFeatureClass, pClipFeatureClass, _
                                  sOutFileName, dFuzzyTol)
      If Not pOutFeatureClass Is Nothing Then
        Set pFeatureLayer = New FeatureLayer
        Set pFeatureLayer.FeatureClass = pOutFeatureClass
        pFeatureLayer.Name = pOutFeatureClass.AliasName
        pMap.AddLayer pFeatureLayer
      End If
    End If
  Next j
  Set pMxDoc = Nothing
  Exit Sub
EH:
  Set pMxDoc = Nothing
  MsgBox Err.Description
End Sub