' 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.
' 




'
'Title: Automatic symbol rotation
'Date: November 28, 2000
'Purpose: This sample code is designed to automatically rotate point symbols based on the
'         line feature they are snapped to.  The point features being added must have symbol
'         rotation turned on for the extension to work correctly.
'
'To use:
'1.) Run Categories.exe and register the dll under ESRI Editor Extensions.
'2.) Start ArcMap and line and point data.
'3.) Make sure the symbology of at least one point layer is set for symbol rotation
'4.) Snap the point feature with rotation symbology to other line features.
'
Option Explicit

Implements IExtension

Dim WithEvents m_pEd As Editor
Dim WithEvents m_pMap As Map
Dim m_pEditor As IEditor
Dim m_bTracking As Boolean
Dim m_pRenderer As IRotationRenderer
Dim m_dClosestDist As Double

Private Sub Class_Initialize()
  m_bTracking = False
End Sub

Private Property Get IExtension_Name() As String
  IExtension_Name = "Switch Attribute Mover"
End Property

Private Sub IExtension_Shutdown()
  Set m_pEditor = Nothing
  Set m_pEd = Nothing
  Set m_pRenderer = Nothing
End Sub

Private Sub IExtension_Startup(initializationData As Variant)
  Set m_pEditor = initializationData
  Set m_pEd = m_pEditor
End Sub

Private Sub m_pEd_OnCreateFeature(ByVal obj As esriGeoDatabase.IObject)
On Error GoTo ErrHand:
  If m_bTracking Then
    Rotate obj, True
  End If
    
  Exit Sub
  
ErrHand:
  MsgBox "RotateSymbolOnCreate - " & Err.Description
End Sub

Private Sub Rotate(obj As IObject, bSetToZero As Boolean)
On Error GoTo ErrHand:

  Dim pAddFeature As IFeature
  Dim iLoop As Integer, pField As Long
  Dim pSnapEnv As ISnapEnvironment
  Dim pSnapAgent As IFeatureSnapAgent
  Dim pTempSegment As ISegment, pClosestSegment As ISegment
  Dim pFields As IFields, dAngle As Double
  
  Set pAddFeature = obj
  
  'Figure out what segment we snapped to.
  Set pTempSegment = Nothing
  Set pClosestSegment = Nothing
  Set pSnapEnv = m_pEditor
  m_dClosestDist = 999999999
  For iLoop = 0 To pSnapEnv.SnapAgentCount - 1
    If TypeOf pSnapEnv.SnapAgent(iLoop) Is IFeatureSnapAgent Then
      Set pSnapAgent = pSnapEnv.SnapAgent(iLoop)
      If pSnapAgent.HitType = esriGeometryPartBoundary And _
       (pSnapAgent.FeatureClass.ShapeType = esriGeometryPolyline Or _
       pSnapAgent.FeatureClass.ShapeType = esriGeometryPolygon) Then
        Set pTempSegment = FindClosestSegment(pAddFeature, _
         pSnapEnv.SnapTolerance, pSnapAgent.FeatureCache)
        If Not pTempSegment Is Nothing Then
          Set pClosestSegment = pTempSegment
        Else
        End If
      End If
    End If
  Next iLoop
  
  'Get the angle from the segment we snapped to.
  If Not pClosestSegment Is Nothing Then
    Dim pLine As ILine
    If TypeOf pClosestSegment Is ILine Then
      Set pLine = New esriGeometry.Line
      pLine.PutCoords pClosestSegment.FromPoint, pClosestSegment.ToPoint
    ElseIf TypeOf pClosestSegment Is ICurve Then
      Dim pCurve As ICurve
      Dim pOutPoint As IPoint
      Set pOutPoint = New esriGeometry.Point
      Set pLine = New esriGeometry.Line
      Dim dAlongDist As Double, dFromDist As Double, dLength As Double, bSide As Boolean
      Set pCurve = pClosestSegment
      pCurve.QueryPointAndDistance esriExtendTangents, pAddFeature.Shape, False, pOutPoint, dAlongDist, _
        dFromDist, bSide
      dLength = 1
      pCurve.QueryTangent esriExtendTangents, dAlongDist, False, dLength, pLine
    End If
    'Rotate the symbol to the correct angle
    dAngle = pLine.Angle * (180 / 3.14159265358979)
    If m_pRenderer.RotationType = esriRotateSymbolGeographic Then
      dAngle = Abs(dAngle - 360) + 90
    End If
    If dAngle > 360 Then
      dAngle = dAngle - 360
    ElseIf dAngle < 0 Then
      dAngle = dAngle + 360
    End If
  Else
    If bSetToZero Then
      dAngle = 0
    End If
  End If
  
  'Apply the angle we found
  Set pFields = pAddFeature.Fields
  pField = pFields.FindField(m_pRenderer.RotationField)
  pAddFeature.Value(pField) = Round(dAngle, 0)
  
  Exit Sub
  
ErrHand:
  MsgBox "Rotate - " & Err.Description
  Exit Sub
End Sub

Private Sub m_pEd_OnCurrentLayerChanged()
  TrackingCheck
End Sub

Private Function FindClosestSegment(pPtFeature As IFeature, _
 pSnapTolerance As Double, pFeatureCache As IFeatureCache) As ISegment
  Dim pLoop As Integer, pSnapDist As Double, lPart As Long, lSegment As Long
  Dim pGeom As IHitTest, pTempSegment As ISegment
  Dim bSnapFlag As Boolean, pTempPolyline As ISegmentCollection
  Dim pHitPoint As IPoint, bSide As Boolean
  Dim pGeomColl As IGeometryCollection, pTempPolyline2 As ISegmentCollection
  Set pHitPoint = New esriGeometry.Point
  Set pTempSegment = Nothing
  For pLoop = 0 To pFeatureCache.Count - 1
    Set pGeom = pFeatureCache.Feature(pLoop).Shape
    bSnapFlag = pGeom.HitTest(pPtFeature.Shape, pSnapTolerance, esriGeometryPartBoundary, _
     pHitPoint, pSnapDist, lPart, lSegment, bSide)
    If bSnapFlag And (pSnapDist < m_dClosestDist) Then
      Set pTempPolyline = pFeatureCache.Feature(pLoop).Shape
      
      Dim pClone As IClone
      If lPart > 0 Then
        Set pGeomColl = pTempPolyline
        Set pTempPolyline2 = pGeomColl.Geometry(lPart)
        Set pClone = pTempPolyline2.Segment(lSegment)
      Else
        Set pClone = pTempPolyline.Segment(lSegment)
      End If
      Set pTempSegment = pClone.Clone
      m_dClosestDist = pSnapDist
    End If
  Next pLoop
  
  Set FindClosestSegment = pTempSegment
End Function

Private Sub m_pEd_OnStartEditing()
  'Set map global at this point, because the Map property of the editor is empty at extension startup
  Set m_pMap = m_pEditor.Map
End Sub

Private Sub m_pMap_ContentsChanged()
  TrackingCheck
End Sub

Private Sub TrackingCheck()
On Error GoTo ErrHand:
  Dim pEdLayer As IEditLayers, pCurLayer As IFeatureLayer
  
  If m_pEditor Is Nothing Then Exit Sub
  If m_pEditor.EditState <> esriStateEditing Then Exit Sub
  
  Set pEdLayer = m_pEditor
  If pEdLayer.CurrentLayer Is Nothing Then
    m_bTracking = False
    Exit Sub
  End If
  
  Set pCurLayer = pEdLayer.CurrentLayer
  If Not TypeOf pCurLayer Is IGeoFeatureLayer Then
    m_bTracking = False
    Exit Sub
  End If
  
  Dim pRenderer As IRotationRenderer
  Dim pGeoLayer As IGeoFeatureLayer
  Set pGeoLayer = pCurLayer
  Set pRenderer = pGeoLayer.Renderer
  If pRenderer.RotationField = "" Then
    m_bTracking = False
    Set m_pRenderer = Nothing
  Else
    Set m_pRenderer = pRenderer
    m_bTracking = True
  End If
  
  Exit Sub
  
ErrHand:
  MsgBox "RotateSym-TrackingCheck - " & Err.Description
End Sub