Some spatial adjustment applications, usually transformations, require that the adjustment be reversed. This means features are adjusted in the reverse 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.
[VBA]
Create displacement links And Set an adjustment method.Paste all the code into VBA.Perform a forward adjustment by running the AdjustForward subroutine.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 = Str(pDLink.ID) + vbTab _
+ Str(pPolyLine.FromPoint.X) + vbTab _
+ Str(pPolyLine.FromPoint.Y) + vbTab _
+ Str(pPolyLine.ToPoint.X) + vbTab _
+ Str(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