Option Explicit

Implements ICommand

Private m_pApp As IApplication 'used to hook the button to the application
Private m_pBitmap As IPictureDisp 'used to set button icon
Private m_bEnabled As Boolean 'used to track button-enabled state
Private m_pEditor As IEditor 'used to reference the ArcMap editor extension
Private WithEvents m_pEditorEvents As esriCore.Editor 'Editor events
Private WithEvents m_cmdOK As CommandButton
Private WithEvents m_cmdCancel As CommandButton

Private Sub Class_Initialize()

  On Error GoTo ErrorHandler
  Set m_pBitmap = LoadResPicture(102, 0)
  
  Exit Sub

ErrorHandler:
  MsgBox "Error " & Err.Number & ": " & Err.Description & vbNewLine _
       & "In " & Err.Source & " at DivideLineFeature.Class_Initialize"
End Sub

Private Sub Class_Terminate()
  Set m_pApp = Nothing
  Set m_pBitmap = Nothing
  Set m_pEditor = Nothing
  Set m_pEditorEvents = Nothing
End Sub

Private Property Get ICommand_Bitmap() As esriCore.OLE_HANDLE
  On Error GoTo ErrorHandler
  
  ICommand_Bitmap = m_pBitmap
  
  Exit Sub

ErrorHandler:
  MsgBox "Error " & Err.Number & ": " & Err.Description & vbNewLine _
       & "In " & Err.Source & " at DivideLineFeature.ICommand_Bitmap"
End Property

Private Property Get ICommand_Caption() As String
  ICommand_Caption = "Divide Line Feature(s)"
End Property

Private Property Get ICommand_Category() As String
  ICommand_Category = "Developer Samples"
End Property

Private Property Get ICommand_Checked() As Boolean

End Property

Private Property Get ICommand_Enabled() As Boolean
  On Error GoTo ErrorHandler
  
  If m_bEnabled = True Then
    ICommand_Enabled = True
  End If
  
  Exit Sub

ErrorHandler:
  MsgBox "Error " & Err.Number & ": " & Err.Description & vbNewLine _
       & "In " & Err.Source & " at DivideLineFeature.ICommand_Enabled"
End Property

Private Property Get ICommand_HelpContextID() As Long

End Property

Private Property Get ICommand_HelpFile() As String

End Property

Private Property Get ICommand_message() As String
  ICommand_message = "Divide selected line feature(s) evenly or by distance."
End Property

Private Property Get ICommand_Name() As String
  ICommand_Name = "DivideLineFeatures"
End Property

Private Sub ICommand_OnClick()
  On Error GoTo ErrorHandler
  
  frmDivideLineFeatures.Show
  Set m_cmdOK = frmDivideLineFeatures.cmdOK
  Set m_cmdCancel = frmDivideLineFeatures.cmdCancel
  
  Exit Sub

ErrorHandler:
  MsgBox "Error " & Err.Number & ": " & Err.Description & vbNewLine _
       & "In " & Err.Source & " at DivideLineFeature.ICommand_OnClick"
End Sub

Private Sub ICommand_OnCreate(ByVal hook As Object)
  On Error GoTo ErrorHandler
  
  Set m_pApp = hook
  Dim pID As New UID
  pID = "esriCore.Editor"
  Set m_pEditor = m_pApp.FindExtensionByCLSID(pID)
  Set m_pEditorEvents = m_pEditor
  
  Exit Sub

ErrorHandler:
  MsgBox "Error " & Err.Number & ": " & Err.Description & vbNewLine _
       & "In " & Err.Source & " at DivideLineFeature.ICommand_OnCreate"
End Sub

Private Property Get ICommand_Tooltip() As String
  ICommand_Tooltip = "Divide Line Feature(s)"
End Property

Private Sub m_pEditorEvents_OnSelectionChanged()
  On Error GoTo ErrorHandler
  
  m_bEnabled = False
  
  Dim pEnumFeature As IEnumFeature
  Dim pFeature As iFeature

  If m_pEditor.SelectionCount > 0 Then
    m_bEnabled = True
    Set pEnumFeature = m_pEditor.EditSelection
    pEnumFeature.Reset
    Set pFeature = pEnumFeature.Next
    Do Until pFeature Is Nothing
      If Not pFeature.Shape.GeometryType = esriGeometryPolyline Then
        m_bEnabled = False
        Exit Do
      End If
      Set pFeature = pEnumFeature.Next
    Loop
  End If
  
  Exit Sub

ErrorHandler:
  MsgBox "Error " & Err.Number & ": " & Err.Description & vbNewLine _
       & "In " & Err.Source & " at DivideLineFeature.m_pEditorEvents_OnSelectionChanged"
End Sub
Private Sub m_cmdOK_Click()
  On Error GoTo ErrorHandler
  
  'grab values from frmDivideLineFeatures and validate input
  If frmDivideLineFeatures.OptSplitEvenly.Value = True Then
    If IsNumeric(frmDivideLineFeatures.txtSplitEvenly.Text) Then
      Dim iSplitEvenly As Double
      iSplitEvenly = frmDivideLineFeatures.txtSplitEvenly.Text
    Else
      MsgBox "Invalid Value", vbOKOnly, "Error"
      frmDivideLineFeatures.txtSplitEvenly.SetFocus
    End If
    
  Else 'SplitByDistance option was selected
    If IsNumeric(frmDivideLineFeatures.txtSplitByDistance.Text) Then
      Dim dSplitByDistance As Integer
      dSplitByDistance = frmDivideLineFeatures.txtSplitByDistance.Text
      
      'Determine orientation, if True split from Start
      Dim bOrientation As Boolean
      bOrientation = frmDivideLineFeatures.optFromStart.Value
    Else
      MsgBox "Invalid Value", vbOKOnly, "Error"
      frmDivideLineFeatures.txtSplitEvenly.SetFocus
    End If
  End If
  
  'Get the selected line feature(s) to divide
  Dim pEnumFeature As IEnumFeature
  Set pEnumFeature = m_pEditor.EditSelection
  pEnumFeature.Reset
  Dim pFeature As iFeature
  
  m_pEditor.StartOperation
  
  Dim iFeature As Integer
  For iFeature = 0 To m_pEditor.SelectionCount - 1
  
    Set pFeature = pEnumFeature.Next
    
    'prepare to invalidate the features extent
    Dim pInvalidArea As IInvalidArea
    Set pInvalidArea = New InvalidArea
    Set pInvalidArea.Display = m_pEditor.Display
    pInvalidArea.Add pFeature
    
    'get length of polyline
    Dim pPolyline As IPolyline
    Set pPolyline = pFeature.Shape
    Dim dPolylineLength As Double
    dPolylineLength = pPolyline.length
    
    'Create point(s) objects used to split featue
    Dim pSplitPoint As IPoint
    Dim pSplitPoints As IMultipoint
    Set pSplitPoints = New Multipoint
    Dim pPointColl As IPointCollection
    Set pPointColl = pSplitPoints
    
    'Test to see what split option the user choose
    'and create point feature to split the line feature
    If frmDivideLineFeatures.OptSplitEvenly.Value = True Then
      Dim dSplitPercentLength As Double
      dSplitPercentLength = 1 / iSplitEvenly
      Dim dAccumulativePercent As Double
      dAccumulativePercent = dSplitPercentLength
      Dim i As Integer
      
      For i = 1 To iSplitEvenly - 1
        Set pSplitPoint = New Point
        'return splitlocation as a point feature
        pPolyline.QueryPoint 0, dAccumulativePercent, True, pSplitPoint
        pPointColl.AddPoint pSplitPoint
        dAccumulativePercent = dAccumulativePercent + dSplitPercentLength
      Next i
      SplitFeature pFeature, pPointColl
      
    Else 'Split by distance was choosen
      Dim dAccumulativeLength As Double
      dAccumulativeLength = dSplitByDistance
      
      'check for orientation, if "from end", then clone and flip polyline
      If frmDivideLineFeatures.optFromStart = True Then
        Do While dAccumulativeLength < dPolylineLength
          Set pSplitPoint = New Point
          'return splitlocation as a point feature
          pPolyline.QueryPoint 0, dAccumulativeLength, False, pSplitPoint
          pPointColl.AddPoint pSplitPoint
          dAccumulativeLength = dAccumulativeLength + dSplitByDistance
        Loop
        SplitFeature pFeature, pPointColl
      Else
        Dim pPolylineFlipped As IPolyline
        Set pPolylineFlipped = pFeature.Shape
        pPolylineFlipped.ReverseOrientation
        Do While dAccumulativeLength < dPolylineLength
          Set pSplitPoint = New Point
          'return splitlocation as a point feature
          pPolylineFlipped.QueryPoint 0, dAccumulativeLength, False, pSplitPoint
          pPointColl.AddPoint pSplitPoint
          dAccumulativeLength = dAccumulativeLength + dSplitByDistance
        Loop
        SplitFeature pFeature, pPointColl
      End If
    End If
  
  Next iFeature
  
  m_pEditor.StopOperation ("Divide Line Feature(s)")

  'clearselection & refresh
  Dim pMxDoc As IMxDocument
  Set pMxDoc = m_pApp.Document
  pMxDoc.FocusMap.ClearSelection
  pMxDoc.ActiveView.Refresh
  Unload frmDivideLineFeatures
  
  Exit Sub

ErrorHandler:
  MsgBox "Error " & Err.Number & ": " & Err.Description & vbNewLine _
       & "In " & Err.Source & " at DivideLineFeature.m_cmdOk_Click"
End Sub
Private Sub m_cmdCancel_Click()
  Unload frmDivideLineFeatures
End Sub

Private Sub SplitFeature(pFeature As iFeature, pSplitPoints As IPointCollection)
  On Error GoTo ErrorHandler
  
  Dim pEnumVertex As IEnumVertex
  Dim pGeoColl As IGeometryCollection
  Dim pPolyCurve As IPolycurve2
  Dim pEnumSplitPoint As IEnumSplitPoint
  Dim pNewFeature As iFeature
  Dim PartCount As Integer
  
  'Split the found features, each split makes a new part
  Set pEnumVertex = pSplitPoints.EnumVertices
  Set pPolyCurve = pFeature.Shape
  Set pEnumSplitPoint = pPolyCurve.SplitAtPoints(pEnumVertex, True, True, -1)
  
  If Not pEnumSplitPoint.SplitHappened Then Exit Sub
  
  'Convert each part to a new feature
  Set pGeoColl = pPolyCurve
  Dim pFClass As IFeatureClass
  Set pFClass = pFeature.Table
  For PartCount = 0 To pGeoColl.GeometryCount - 1
    Set pNewFeature = pFClass.CreateFeature
    Set pNewFeature.Shape = BUILDPOLYLINE(pGeoColl.Geometry(PartCount))
    COPYATTRIBUTES pFeature, pNewFeature
    pNewFeature.Store
  Next PartCount
  
  'Delete the original feature to be archived
  pFeature.Delete
  Exit Sub

ErrorHandler:
  MsgBox "Error " & Err.Number & ": " & Err.Description & vbNewLine _
       & "In " & Err.Source & " at DivideLineFeature.SplitFeature"
End Sub

Private Sub COPYATTRIBUTES(pSourceFeature As iFeature, pDestinationFeature As iFeature)
  Dim pField As IField
  Dim pFields As IFields
  Dim pRow As IRow
  Dim FieldCount As Integer
  On Error GoTo ErrorHandler
  
  Set pFields = pSourceFeature.Fields
  For FieldCount = 0 To pFields.FieldCount - 1
    Set pField = pFields.Field(FieldCount)
    If pField.Editable Then
      If Not pField.Type = esriFieldTypeOID And Not pField.Type = esriFieldTypeGeometry Then
        pDestinationFeature.Value(FieldCount) = pSourceFeature.Value(FieldCount)
      End If
    End If
  Next FieldCount
  Exit Sub

ErrorHandler:
  MsgBox "Error " & Err.Number & ": " & Err.Description & vbNewLine _
       & "In " & Err.Source & " at DivideLineFeature.COPYATTRIBUTES"
End Sub

Private Function BUILDPOLYLINE(pSegColl As ISegmentCollection) As IPolyline
  On Error GoTo ErrorHandler
  Dim pPolyline As IGeometryCollection
  Set pPolyline = New Polyline
  pPolyline.AddGeometries 1, pSegColl
  Set BUILDPOLYLINE = pPolyline
  Exit Function

ErrorHandler:
  MsgBox "Error " & Err.Number & ": " & Err.Description & vbNewLine _
       & "In " & Err.Source & " at DivideLineFeature.BUILDPOLYLINE"
End Function