Reverse Adjustment

Created:3/25/2002
Description:

Some spatial adjustment applications, usually transformations, require that the adjustment be reversed. This means features are adjusted in the rerverse direction of the displacement link, rather than the default forward direction.

This tip demonstrates this by saving links during a normal or forward adjustment then reversing and applying these links during a reverse or backward adjustment.


How to use:
  1. Create displacement links and set an adjustment method.
  2. Paste all the code into VBA.
  3. Perform a forward adjustment by running the AdjustForward subroutine.
  4. Perform a reverse adjustment by running the AdjustBackward subroutine.
Option Explicit

Public Sub AdjustForward()

  'Save links to scratch file then adjust
  
  Dim pMxDoc As IMxDocument
  Dim pGraCon As IGraphicsContainer
  Dim pElement As IElement
  Dim pDLink As IDisplacementLinkElement
  Dim pPolyLine As IPolyline
  Dim pCmd As ICommandItem
  
  Dim strAdjFile As String
  Dim strRec As String
  
  'Get the graphics container
  Set pMxDoc = ThisDocument
  Set pGraCon = pMxDoc.FocusMap
  pGraCon.Reset
  
  'Create ascii link file
  strAdjFile = VBA.Environ("TEMP") + "\Adjustment.txt"
  Open strAdjFile For Output As #1
  
  'Enumerate through graphics container
  Set pElement = pGraCon.Next
  
  Do Until pElement Is Nothing
    'Find displacement links
    If TypeOf pElement Is IDisplacementLinkElement Then
      Set pDLink = pElement
      Set pPolyLine = pElement.Geometry
      
      'write coordinates to text file
      strRec = pDLink.ID + vbTab _
        + pPolyLine.FromPoint.X + vbTab _
        + pPolyLine.FromPoint.Y + vbTab _
        + pPolyLine.ToPoint.X + vbTab _
        + pPolyLine.ToPoint.Y + vbTab
      
      Print #1, strRec
      
    End If
    
    Set pElement = pGraCon.Next
  Loop
  
  'Close the file
  Close #1
  
  'Find the adjust command and execute it
  ThisDocument.CommandBars.Find(arcid.Adjust_Transform).Execute

End Sub

Public Sub AdjustBackward()

  'Read links from adjustment file, reverse and adjust
  
  Dim pMxDoc As IMxDocument
  Dim pAdjustProp As IAdjustProperties
  Dim pGraCon As IGraphicsContainer
  Dim pElement As IElement
  Dim pDLink As IDisplacementLinkElement
  Dim pPolyLine As IPolyline
  Dim pPoint As IPoint
  
  Dim strAdjFile As String
  Dim strRec As String
  Dim colRec As Collection
  
  'Get the map and graphics container
  Set pMxDoc = ThisDocument
  Set pGraCon = pMxDoc.FocusMap
  
  'Get the adjustment propertes
  Set pAdjustProp = Application.FindExtensionByName("ESRI Adjustment  Tools")
  
  'Get the adjustment file name
  strAdjFile = VBA.Environ("TEMP") + "\Adjustment.txt"
  
  'Open the file and read each record until the end
  Open strAdjFile For Input As #1
  
  Do Until EOF(1)
    
    Line Input #1, strRec
    Set colRec = AsTokens(strRec, vbTab)
    
    'Create a displacement link reversing the coodinates
    Set pPolyLine = New Polyline
    
    Set pPoint = New Point
    pPoint.PutCoords colRec(4), colRec(5)
    pPolyLine.FromPoint = pPoint
    
    Set pPoint = New Point
    pPoint.PutCoords colRec(2), colRec(3)
    pPolyLine.ToPoint = pPoint
    
    Set pDLink = New DisplacementLinkElement
    Set pElement = pDLink
    
    pElement.Geometry = pPolyLine
    pDLink.ID = colRec(1)
    pDLink.Symbol = pAdjustProp.DisplacementLinkSymbol
    
    'Add the link to the graphics container
    pGraCon.AddElement pElement, 0
    
  Loop
  
  'Close the file
  Close #1
  
  'Find the adjust command and execute it
  ThisDocument.CommandBars.Find(arcid.Adjust_Transform).Execute

End Sub


Private Function AsTokens(sString As String, sDelimiter As String) As  Collection
' Break the string out into a collection, breaking it apart by the  delimiter character
  Dim lLoop As Long
  Dim lIndex As Long
  Dim lIndex_Prev As Long
  Dim sSubString As String
  lIndex_Prev = 0
  lIndex = 0
  Set AsTokens = New Collection
  lIndex = InStr(sString, sDelimiter)
  While lIndex > 0
    sSubString = Mid(sString, lIndex_Prev + 1, (lIndex - lIndex_Prev - 1))
    AsTokens.Add sSubString
    lIndex_Prev = lIndex
    lIndex = InStr(lIndex + 1, sString, sDelimiter)
  Wend
  sSubString = Right(sString, Len(sString) - lIndex_Prev)
  AsTokens.Add sSubString
End Function