UpdateByTopology
clsUpdateFeatures.cls

' Copyright 1995-2004 ESRI

' All rights reserved under the copyright laws of the United States.

' You may freely redistribute and use this sample code, with or without modification.

' Disclaimer: THE SAMPLE CODE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED 
' WARRANTIES, INCLUDING THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 
' FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL ESRI OR 
' CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, 
' OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
' SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
' INTERRUPTION) SUSTAINED BY YOU OR A THIRD PARTY, HOWEVER CAUSED AND ON ANY 
' THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ARISING IN ANY 
' WAY OUT OF THE USE OF THIS SAMPLE CODE, EVEN IF ADVISED OF THE POSSIBILITY OF 
' SUCH DAMAGE.

' For additional information contact: Environmental Systems Research Institute, Inc.

' Attn: Contracts Dept.

' 380 New York Street

' Redlands, California, U.S.A. 92373 

' Email: contracts@esri.com

Option Explicit
Option Base 0

Implements ICommand
Private m_pEditor As esriEditor.IEditor
Private m_pMXApp As esriArcMapUI.IMxApplication
Private m_pApp As IApplication
Private m_pTopoExt As esriEditorExt.ITopologyExtension
Private m_pSurveyExt As esriSystem.IExtension
Private m_TopoFunctions As TopologyFunctions
Private m_AvailableMethod As enumTransformationMethod
Private m_bExit As Boolean
Private m_pTransF As esriGeometry.IAffineTransformation2D3
Private m_pTopoG As esriGeoDatabase.ITopologyGraph
Private m_pTopoSpatRef As esriGeometry.ISpatialReference
Private WithEvents m_pUpdateFrm As Form
Private WithEvents m_OK As CommandButton
Private WithEvents m_Cancel As CommandButton

Private Sub Class_Initialize()
  Set m_pUpdateFrm = frmUpdateMethod
  Set m_OK = frmUpdateMethod.cmdOK
  Set m_Cancel = frmUpdateMethod.cmdCancel
  Set m_TopoFunctions = New TopologyFunctions
End Sub

Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE
End Property

Private Property Get ICommand_Caption() As String
  ICommand_Caption = "Update Features in Topology..."
End Property

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

Private Property Get ICommand_Checked() As Boolean
  ICommand_Checked = False
End Property

Private Property Get ICommand_Enabled() As Boolean
  Dim pTopo As esriGeoDatabase.ITopology, pMapTopol As esriEditorExt.IMapTopology, pTopoG As esriGeoDatabase.ITopologyGraph
  ICommand_Enabled = False
  If m_pTopoExt Is Nothing Then Exit Property
  If m_pSurveyExt Is Nothing Then Exit Property
   
  If TypeOf m_pTopoExt.CurrentTopology Is esriEditorExt.IMapTopology Then
    Set pMapTopol = m_pTopoExt.MapTopology
    Set pTopoG = pMapTopol.Cache
  Else
    Set pTopo = m_pTopoExt.CurrentTopology
    Set pTopoG = pTopo.Cache
  End If
  
  'Check for a topology graph
  If pTopoG Is Nothing Then Exit Property

  'Check for an feature selection
  If m_pEditor.SelectionCount > 0 Then _
  ICommand_Enabled = m_pEditor.EditState = esriStateEditing
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 = "Update selected features in a topology based on survey points"
End Property

Private Property Get ICommand_Name() As String
  ICommand_Name = "Update Features in Topology"
End Property

Private Sub ICommand_OnClick()
Dim pMXDoc As esriArcMapUI.IMxDocument, iErr As Integer
Dim pSDS As esriSurveyExt.ISurveyDataset, pSAFunc As New SurveyAnalystFunctions
Dim pEnumTopoEdg As esriGeoDatabase.IEnumTopologyEdge, pInvalArea As esriGeoDatabase.IInvalidArea, pSnapPoints As esriGeometry.IMultipoint

Dim pLinkCache As esriSurveyExt.IFeatureSurveyLinkCache, pSegColl As esriGeometry.ISegmentCollection
Dim pInvalid As esriGeometry.IEnvelope, dFromErr As Double, dToError As Double
Dim pMapLU As esriGeometry.ILinearUnit, sUnit As String, pEdProps As esriEditor.IEditProperties

  If m_pEditor.SelectionCount = 0 Then
    MsgBox "You need to select features."
    Exit Sub
  End If
  
  On Error GoTo handler

  Set m_pTopoG = m_TopoFunctions.GetTopologyGraph(m_pTopoExt)
  Set m_pTopoSpatRef = m_TopoFunctions.GetTopologySpatRef(m_pTopoExt)
  m_TopoFunctions.BuildTopologyForFeatureSelection m_pEditor.EditSelection, m_pTopoG, False
  
  Set pMXDoc = m_pApp.Document
  Set pSDS = pSAFunc.GetSurveyDatasetFromMapLayers(pMXDoc.FocusMap.Layers)
  
  If pSDS Is Nothing Then
    MsgBox "Add a survey layer to the map."
    Exit Sub
  End If
  
  Set pEnumTopoEdg = m_TopoFunctions.SelectTopoEdgesFromFeatures(m_pEditor.EditSelection, m_pTopoExt, m_pTopoG)
  
  Set pInvalArea = New InvalidArea
  Set pInvalArea.Display = m_pEditor.Display
  pInvalArea.Add m_pEditor.EditSelection

  Set pLinkCache = pSDS
  Set pSnapPoints = pSAFunc.GetSnappedVertices(m_pEditor.EditSelection, pLinkCache, m_pEditor.Map.SpatialReference, m_pTopoSpatRef)
  
  Set pSegColl = _
  m_TopoFunctions.GetLinkInfoBySelectedTopoElements(m_pTopoG, pLinkCache)
  
  If pSegColl.SegmentCount > 2 Then
    m_AvailableMethod = Affine
  Else
    m_AvailableMethod = Helmert
    m_pUpdateFrm.chkRMS.Value = 0
  End If
  
  Set pEdProps = m_pEditor
  iErr = 99
  With m_pUpdateFrm
    .Show vbModal
    If Not m_bExit Then
      m_pEditor.StartOperation
      m_TopoFunctions.Update m_pEditor.EditSelection, (.chkSnapVertices.Value = 1), (.chkTransform.Value = 1), _
          pSegColl, m_pTopoExt, m_pEditor.Map.SpatialReference, m_pTopoSpatRef, _
          .cboTransformationMethod.ItemData(.cboTransformationMethod.ListIndex), _
          pSnapPoints, pEdProps.StretchGeometry
      m_pTopoG.Post pInvalid
      pInvalArea.Add pInvalid
      m_pEditor.StopOperation "Update Selected Features In the Current Topology"
    End If
  End With
  m_pTopoG.SetEmpty
  pInvalArea.Invalidate m_pEditor.Display.ActiveCache
  pMXDoc.ActiveView.PartialRefresh esriViewGeography, Nothing, pMXDoc.ActiveView.Extent
  If m_pUpdateFrm.chkRMS.Value = 1 And m_pUpdateFrm.chkTransform.Value = 1 Then
    'If Not m_pTransF Is Nothing Then
    '  m_pTransF.GetRMSError dFromErr, dToError
      If TypeOf m_pTopoSpatRef Is IProjectedCoordinateSystem2 Then
        Dim pPCS As IProjectedCoordinateSystem2: Set pPCS = m_pTopoSpatRef
        sUnit = " " & LCase(pPCS.CoordinateUnit.Name) & "s"
      Else
        sUnit = " degrees"
      End If
      MsgBox Format(CStr(m_TopoFunctions.RootMeanSquareError), "0.00000") & sUnit, vbInformation, _
      "Root Mean Square (RMS) Error"
    'End If
  End If
  Unload m_pUpdateFrm
Exit Sub
handler:
  MsgBox Err.Description & " " & iErr
End Sub

Private Sub ICommand_OnCreate(ByVal hook As Object)
  Set m_pMXApp = hook
  Set m_pApp = m_pMXApp
  Set m_pEditor = m_pApp.FindExtensionByName("esri object editor")
  Set m_pTopoExt = m_pApp.FindExtensionByName("esri topology extension")
  Set m_pSurveyExt = m_pApp.FindExtensionByName("SurveyAnalyst_ArcMapExtension")
End Sub

Private Property Get ICommand_Tooltip() As String
  ICommand_Tooltip = "Update Selected Features to Survey Point Locations"
End Property

Public Sub Setup(Method As enumTransformationMethod)
  m_pUpdateFrm.chkRMS.Enabled = False
  m_pUpdateFrm.cboTransformationMethod.Clear
  m_pUpdateFrm.cboTransformationMethod.AddItem "Helmert Transformation", 0
  m_pUpdateFrm.cboTransformationMethod.ItemData(0) = 0

  Select Case Method
  Case 0

  Case 1
    m_pUpdateFrm.cboTransformationMethod.AddItem "Affine Transformation", 1
    m_pUpdateFrm.cboTransformationMethod.ItemData(1) = 1
  End Select
  m_pUpdateFrm.cboTransformationMethod.ListIndex = 0
End Sub

Private Sub m_Cancel_Click()
  m_bExit = True
  Unload m_pUpdateFrm
End Sub

Private Sub m_OK_Click()
  m_pUpdateFrm.Hide
  m_bExit = False
End Sub

Private Sub m_pUpdateFrm_KeyPress(KeyAscii As Integer)
  Select Case KeyAscii
    Case 13
      m_pUpdateFrm.Hide
      m_bExit = False
    Case 27
      m_bExit = True
      Unload m_pUpdateFrm
  End Select
End Sub

Private Sub m_pUpdateFrm_Load()
  Setup m_AvailableMethod
End Sub

Private Sub m_pUpdateFrm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Select Case UnloadMode
    Case 0, 1
      m_bExit = True
  End Select
End Sub