' Copyright 2008 ESRI
' 
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
' 
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
' 
' See use restrictions at <your ArcGIS install location>/developerkit/userestrictions.txt.
' 




' LoopConstructTool
'
' implements ITool and ICommand
'
' handles all graphic feedback in DrawFeedback - rubber bands a line and
' draws the the snap cursor
'
Option Explicit

Implements ICommand
Implements ITool

Private iPtCount As Integer
Private m_dOffset As Double
Private m_lContructOption As Long
' these are the member variables for our component
'
Dim m_pApp As IApplication
Dim m_pEditor As IEditor            ' our friend, the editor
Dim m_pSketch As IEditSketch        ' a 2nd interface on the editor for working with the edit sketch
Dim m_pDpy As IAppDisplay           ' the application's display, which we draw into frequently
Dim m_pLoc As IPoint                ' the current mouse location at any time
Dim m_pSnapFeature As IFeature
Dim m_pNoSnapLoc As IPoint
Dim m_pFinalPolyline As IPolyline
  
Dim m_pPolyline As IGeometry        ' for feedback only - an optimization to avoid object creation
Dim m_pLine1 As ILine                ' the one segment for m_pPolyline - also an optimization
Dim m_pLine2 As ILine
Dim m_pLine3 As ILine
Dim m_pSym As ISimpleLineSymbol     ' a rubber banding symbol for our line

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const VK_SHIFT = &H10
Private Const VK_SPACE = &H20

Private Sub Class_Initialize()
  ' here's where we initialize the object
  
  On Error Resume Next
  
  ' create the polyline and attach a line segment
  ' note: these geometric primitives are only necessary
  ' to optimize drawing by avoiding creating objects all the time
  '
  Set m_pLine1 = New esriGeometry.Line
  Set m_pLine2 = New esriGeometry.Line
  Set m_pLine3 = New esriGeometry.Line
  Set m_pPolyline = New Polyline
  Dim pSegColl As ISegmentCollection
  Set pSegColl = m_pPolyline
  pSegColl.AddSegment m_pLine1
  pSegColl.AddSegment m_pLine2
  pSegColl.AddSegment m_pLine3
  
  ' set up a symbol for feedback
  ' also a drawing optimization
  '
  Dim m_test As ISymbol
  Set m_test = New SimpleLineSymbol
  m_test.ROP2 = esriROPXOrPen
  Set m_pSym = m_test
  m_pSym.Style = esriSLSDot
  m_pSym.Width = 3
  Dim c As IColor
  Set c = m_pSym.Color
  c.RGB = 32768
  m_pSym.Color = c
  
  ' initialize m_pLoc
  Set m_pLoc = New Point
  Set m_pNoSnapLoc = New Point
  
End Sub

Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE
  ICommand_Bitmap = frmResources.picLotOffset.Picture.Handle
End Property

Private Property Get ICommand_Caption() As String
  ICommand_Caption = "Loop Construction Entry"
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
  ' enable the tool only if we're editing and the current
  ' geometry type is polyline
  
  ICommand_Enabled = False
  If Not m_pEditor.Map Is Nothing Then
    ICommand_Enabled = m_pSketch.GeometryType = esriGeometryPolyline
  End If
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

End Property

Private Property Get ICommand_Name() As String
  ICommand_Name = "Loop Construct Tool"
End Property

Private Sub ICommand_OnClick()
  'Make sure we are not trying to add to a simple edge feature class
  Dim pEdLayer As IEditLayers
  Set pEdLayer = m_pEditor
  If pEdLayer.CurrentLayer.FeatureClass.FeatureType = esriFTSimpleEdge Then
    MsgBox "Tool can only be used for adding complex edges and simple line features!!"
    Set pEdLayer = Nothing
    Set m_pApp.CurrentTool = Nothing
    Exit Sub
  End If
  Set pEdLayer = Nothing
  
  frmOffset.lContructOption = m_lContructOption
  frmOffset.dRailOffset = m_dOffset
  frmOffset.Show vbModal
  m_dOffset = frmOffset.dRailOffset
  m_lContructOption = frmOffset.lContructOption
  Unload frmOffset
  
  iPtCount = 0
End Sub

Private Sub ICommand_OnCreate(ByVal hook As Object)
  ' attach our members to the application, the display, and the editor
  '
  Dim pMXApp As IMxApplication
  Set m_pApp = hook
  Set pMXApp = m_pApp
  Set m_pDpy = pMXApp.Display
  
  Dim pUID As New UID
  pUID = "esriEditor.editor"
  Set m_pEditor = m_pApp.FindExtensionByCLSID(pUID)
  Set m_pSketch = m_pEditor
  
  m_lContructOption = 0
  m_dOffset = 20
End Sub

Private Property Get ICommand_ShortCutKey() As String

End Property

Private Property Get ICommand_Tooltip() As String
  ICommand_Tooltip = "Loop Construct Tool"
End Property

Private Property Get ITool_Cursor() As esriSystem.OLE_HANDLE

End Property

Private Function ITool_Deactivate() As Boolean
  ' clean up
  DrawFeedback 0
  m_pLoc.SetEmpty
  
  ITool_Deactivate = True  ' this tells mapstudio that we're done
End Function

Private Function ITool_OnContextMenu(ByVal x As Long, ByVal y As Long) As Boolean

End Function

Private Sub ITool_OnDblClick()
  ' here's where we provide a nice shortcut to finishing
  ' the edit sketch, or to finish a single part
  '
  m_pLoc.SetEmpty
  
  ' either finish the part or the sketch, depending on whether
  ' or not the shift key is down
  If GetKeyState(VK_SHIFT) < 0 Then
    m_pSketch.FinishSketchPart
  Else
    m_pSketch.FinishSketch
  End If
  
End Sub

Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal shift As Long)

End Sub

Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal shift As Long)

End Sub

Private Sub ITool_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
On Error GoTo ErrorHandler
  If button <> 1 Or m_dOffset = 0 Then
    frmOffset.lContructOption = m_lContructOption
    frmOffset.dRailOffset = m_dOffset
    frmOffset.Show vbModal
    m_dOffset = frmOffset.dRailOffset
    m_lContructOption = frmOffset.lContructOption
    Unload frmOffset
    
    If button <> 1 Then Exit Sub
  End If
  
  'Make sure the point is snapped
  Dim pSnap As ISnapEnvironment
  Set pSnap = m_pEditor
  If Not pSnap.SnapPoint(m_pLoc) Then
    MsgBox "First point must snap to an edge feature!!!"
    Exit Sub
  End If
  
  If iPtCount <= 0 Or iPtCount > 1 Then
    m_pSketch.AddPoint m_pLoc, False

    Dim pFeatLayer As IFeatureLayer, pEdLayer As IEditLayers, pFeat As IFeature
    Dim pSpatialFilter As ISpatialFilter, pFeatCursor As IFeatureCursor
    Dim pFC As IFeatureClass, pPolygon As IPolygon
    Dim pTopoOp As ITopologicalOperator
    Set pSpatialFilter = New SpatialFilter
    Set pEdLayer = m_pEditor
    Set pFeatLayer = pEdLayer.CurrentLayer
    Set pFC = pFeatLayer.FeatureClass

    Set pTopoOp = m_pLoc         '  For a search on SDE must use a polygon(etb)
    Set pPolygon = pTopoOp.Buffer(m_dOffset)
    Set pSpatialFilter.Geometry = pPolygon  ' Modified (etb)
    pSpatialFilter.SpatialRel = esriSpatialRelIntersects
    pSpatialFilter.GeometryField = pFC.ShapeFieldName  ' SDE needs the Geometry Field on a spatial filter (etb)

    Set pFeatCursor = pFeatLayer.Search(pSpatialFilter, True)
    Set pFeat = pFeatCursor.NextFeature
    Set m_pSnapFeature = pFeat
    'For some unknown reason it is necessary to get the shape from the feature here
    Dim pPolyLine As IPolyline
    Set pPolyLine = pFeat.Shape
        
    iPtCount = 1
  Else
    'add second point
    m_pSketch.AddPoint m_pLine2.FromPoint, False
    m_pSketch.AddPoint m_pLine2.ToPoint, False
    m_pSketch.AddPoint m_pLoc, False
    Dim pClone As IClone
    Set pClone = m_pSketch.Geometry
    Set m_pFinalPolyline = pClone.Clone
    
    m_pLoc.SetEmpty
    m_pSketch.FinishSketch
    m_pEditor.StartOperation
    'Perform the split to integrate the new segment into the network
    FinishConstruct
    m_pEditor.StopOperation "Loop Construct"
    Set m_pApp.CurrentTool = Nothing
    Dim pDoc As IMxDocument
    Set pDoc = m_pApp.Document
    pDoc.ActiveView.Refresh
    
    iPtCount = 0
  End If
  
  Exit Sub
  
ErrorHandler:
  MsgBox "Mouse Down - " & Err.Description
  m_pEditor.StopOperation "Loop Construct"
  Exit Sub
End Sub

Private Sub ITool_OnMouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
  ' erase existing feedback if necessary
  If Not m_pLoc.IsEmpty Then DrawFeedback 0
  
  ' calculate the new location with always handy ToMapPoint method
  Set m_pLoc = m_pDpy.DisplayTransformation.ToMapPoint(x, y)
  Dim pClone As IClone
  Set pClone = m_pLoc
  Set m_pNoSnapLoc = pClone.Clone
  
  ' snap the point if the space key isn't down
  If GetKeyState(VK_SPACE) >= 0 Then
    Dim pSnapEnv As ISnapEnvironment
    Set pSnapEnv = m_pEditor
    pSnapEnv.SnapPoint m_pLoc
  End If
  
  DrawFeedback 0  ' draw feedback at new location
  
End Sub

Private Sub ITool_OnMouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)

End Sub

Private Sub ITool_Refresh(ByVal hdc As esriSystem.OLE_HANDLE)
  DrawFeedback hdc
End Sub

Private Sub DrawFeedback(hdc As esriSystem.OLE_HANDLE)
  If m_pLoc.IsEmpty Then Exit Sub     ' nothing to do
  
  m_pEditor.InvertAgent m_pLoc, hdc
  
  ' get the anchor point
  Dim anchor As IPoint
  Set anchor = m_pSketch.LastPoint
  If anchor Is Nothing Then
    Exit Sub  ' no line to draw
  End If
  
  If m_pSnapFeature Is Nothing Then
    Exit Sub
  End If
  
  'Get 90 degree angle based on current cursor position
  Dim mSecondPT As IPoint
  Set mSecondPT = FindPerpPt(anchor)
  If mSecondPT Is Nothing Then
    Exit Sub
  End If
  
  ' get the intermediate point
  Dim mTurnPT As IConstructPoint
  Set mTurnPT = New esriGeometry.Point
  Dim dOutAngle As Double, pLine As ILine
  Set pLine = New esriGeometry.Line
  pLine.PutCoords anchor, mSecondPT
  dOutAngle = pLine.Angle
  mTurnPT.ConstructAngleDistance m_pLoc, dOutAngle, m_dOffset
  
  ' draw the rubberband line feedback
  ' grab the activeCache setting in order to restore it later
  Dim ac As Integer
  ac = m_pDpy.ActiveCache
  
  ' draw without a cache - directly on the window
  m_pDpy.ActiveCache = esriNoScreenCache
  m_pDpy.StartDrawing hdc, esriNoScreenCache
  
  m_pDpy.SetSymbol m_pSym
  m_pLine1.PutCoords anchor, mSecondPT
  m_pLine2.PutCoords mSecondPT, mTurnPT
  m_pLine3.PutCoords mTurnPT, m_pLoc
  m_pDpy.DrawPolyline m_pPolyline
  
  ' finish drawing and restore the cache setting
  m_pDpy.FinishDrawing
  m_pDpy.ActiveCache = ac
End Sub

Private Function FindPerpPt(pAnchor As IPoint) As IPoint
On Error GoTo ErrHand:
  If m_pSnapFeature Is Nothing Then
    Set FindPerpPt = Nothing
    Exit Function
  End If
  
  'Find distance along line, then tangent line at that point
  Dim pPolyLine As IPolyline, pOutPt As IPoint, dAlong As Double
  Dim dFrom As Double, bSide As Boolean, pLine As ILine, dLoc As Double
  Set pOutPt = New esriGeometry.Point
  Set pLine = New esriGeometry.Line
  Set pPolyLine = m_pSnapFeature.Shape
  pPolyLine.QueryPointAndDistance esriNoExtension, pAnchor, False, pOutPt, dAlong, dFrom, bSide
  'Determine the side the cursor is currently on
  pPolyLine.QueryPointAndDistance esriExtendTangents, m_pNoSnapLoc, False, pOutPt, dLoc, dFrom, bSide
  If bSide Then
    pPolyLine.QueryNormal esriNoExtension, dAlong, False, m_dOffset, pLine
  Else
    pPolyLine.QueryNormal esriNoExtension, dAlong, False, (-1 * m_dOffset), pLine
  End If
  
  Set FindPerpPt = pLine.ToPoint
  
  Exit Function
  
ErrHand:
  MsgBox "findPerpPt - " & Err.Description
  Set FindPerpPt = Nothing
  Exit Function
End Function

Private Sub FinishConstruct()
On Error GoTo ErrHand:
  Dim pFeatEdit As IFeatureEdit, pResultSet As ISet
  Set pFeatEdit = m_pSnapFeature
  Set pResultSet = pFeatEdit.Split(m_pFinalPolyline.FromPoint)
  If pResultSet.Count <> 2 Then Exit Sub
  pResultSet.Reset
  
  'Find the piece intersected by the end point of the loop construct
  Dim pLoop As Long, pProx As IProximityOperator
  Dim dDist1 As Double, dDist2 As Double
  Dim pNewFeature As IFeature, pCurFeature As IFeature
  For pLoop = 0 To 1
    Set pCurFeature = pResultSet.Next
    Set pProx = pCurFeature.Shape
    If pLoop = 0 Then
      dDist1 = pProx.ReturnDistance(m_pFinalPolyline.ToPoint)
      Set pNewFeature = pCurFeature
    Else
      dDist2 = pProx.ReturnDistance(m_pFinalPolyline.ToPoint)
    End If
    If dDist2 < dDist1 Then
      Set pNewFeature = pCurFeature
    End If
  Next pLoop
  
  'Split the piece intersected by the end point
  Dim pFeatEdit2 As IFeatureEdit, pResultSet2 As ISet
  Set pFeatEdit2 = pNewFeature
  Set pResultSet2 = pFeatEdit2.Split(m_pFinalPolyline.ToPoint)
  If pResultSet2 Is Nothing Then
    MsgBox "no set"
    Exit Sub
  End If
  If pResultSet2.Count <> 2 Then Exit Sub
  pResultSet2.Reset
  
  'Find the piece in the middle and modify or delete it
  Dim pFinalFeat As IFeature, pFinalLine As IPolyline
  Dim pSpan As IPolyline, dLength1 As Double, dLength2 As Double
  Dim pMiddleFeat As IFeature, pProxPt As IProximityOperator
  Set pSpan = New Polyline
  Set pFinalFeat = pResultSet2.Next
  Set pFinalLine = pFinalFeat.Shape
  Set pMiddleFeat = pFinalFeat
  Set pProxPt = pFinalLine.FromPoint
  dLength1 = pProxPt.ReturnDistance(pFinalLine.ToPoint)
  Set pFinalFeat = pResultSet2.Next
  Set pFinalLine = pFinalFeat.Shape
  Set pProxPt = pFinalLine.FromPoint
  dLength2 = pProxPt.ReturnDistance(pFinalLine.ToPoint)
  pSpan.FromPoint = m_pFinalPolyline.FromPoint
  pSpan.ToPoint = m_pFinalPolyline.ToPoint
  If Abs(pSpan.Length - dLength1) > Abs(pSpan.Length - dLength2) Then
    Set pMiddleFeat = pFinalFeat
  End If
  
  If m_lContructOption = 0 Then
    Dim pRow As IRow
    Set pRow = pMiddleFeat
    pRow.Delete
  Else
    'Snip 10% of each end
    Dim pInCurve As ICurve, pOutCurve As ICurve
    If pMiddleFeat Is Nothing Then
      MsgBox "Something is wrong with the middle feature."
    End If
    If TypeOf pMiddleFeat Is INetworkFeature Then
      Dim pNetFeat As INetworkFeature
      Set pNetFeat = pMiddleFeat
      pNetFeat.Disconnect
    End If
    pMiddleFeat.Store
    
    Set pInCurve = pMiddleFeat.Shape
    pInCurve.GetSubcurve 0.1, 0.9, True, pOutCurve
    Set pMiddleFeat.Shape = pOutCurve
    pMiddleFeat.Store
  End If
  
  Exit Sub
  
ErrHand:
  MsgBox "final Construct - " & Err.Description
  m_pEditor.StopOperation "Loop Construct"
  Exit Sub
End Sub