This sample aligns elements to the dominant element. Options are: top, bottom, left, and right. In ArcMap, the dominant element is the last element selected.
There are two parts to this sample. A driver macro and a class that does the actual alignment. The extra class is necessary because we need to implement IOperation to provide undo/redo. This also makes it extensible. For example, you can write a new driver that aligns elements to a feature's envelope.
One of the purposes of this sample is to also show how element operations are created.
How to use
- Paste the AlignGraphicElements routine into VBA.
- Insert a new class module into the VBA project.
- Paste in the class code from below.
- Rename the class module to AlignElementsOperation.
- In the AlignGraphicElements routine, modify the alignment option as desired, currently its set to esriTop.
- Select the elements you wish to align.
- Run the macro.
Macro
Option Explicit
Public Sub AlignGraphicElements()
Dim pMxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pGraphicsContainerSel As IGraphicsContainerSelect
Dim pDominantElement As IElement
Dim pEnumElement As IEnumElement
Dim pAlignEnv As IEnvelope
Dim pElementOp As New AlignElementsOperation
Set pMxDoc = Application.Document
Set pActiveView = pMxDoc.ActivatedView
Set pGraphicsContainerSel = pActiveView
Set pEnumElement = pGraphicsContainerSel.SelectedElements
'Ensure a dominant element exists, all elements are aligned
'to its envelope
Set pDominantElement = pGraphicsContainerSel.DominantElement
If pDominantElement Is Nothing Then
MsgBox "Unable to align elements. No dominant element found."
Exit Sub
End If
Set pAlignEnv = New Envelope
pDominantElement.QueryBounds pActiveView.ScreenDisplay, pAlignEnv
'Call AlignElements to peform the alignment
pElementOp.AlignElements pMxDoc, pEnumElement, pAlignEnv, esriTop
End Sub
Class Module
Option Explicit
'This class aligns selected elements based on an envelope passed in
'Typically the envelope comes from the dominant elemment (IElement::QueryCoords)
'The class implements IOperation to provide undo/redo capabilities.
Implements IOperation
Private m_pActiveView As IActiveView
Private m_pGraphicsContainer As IGraphicsContainer
Private m_pEnumElement As IEnumElement
Private m_pAlignEnv As IEnvelope
Private PointArray() As IPoint
Private m_AlignType As AlignType
Public Enum AlignType
esriTop = 0
esriBottom = 1
esriLeft = 2
esriRight = 3
End Enum
Public Sub AlignElements(pMxDoc As IMxDocument, pEnumElement As IEnumElement, pAlignEnv As IEnvelope, eAlignType As AlignType)
Dim pOperationStack As IOperationStack
Set pOperationStack = pMxDoc.OperationStack
Set m_pActiveView = pMxDoc.ActivatedView
Set m_pEnumElement = pEnumElement
Set m_pAlignEnv = pAlignEnv
Set m_pGraphicsContainer = pMxDoc.ActivatedView
'Even though the enum is public, double-check that a valid value has been passed in
If eAlignType < 0 Or eAlignType > 3 Then
MsgBox "Invalid Alignment Option."
Exit Sub
End If
m_AlignType = eAlignType
'Do the operation and load it onto the operation stack
pOperationStack.Do Me
End Sub
Private Property Get IOperation_CanRedo() As Boolean
IOperation_CanRedo = True
End Property
Private Property Get IOperation_CanUndo() As Boolean
IOperation_CanUndo = True
End Property
Private Sub IOperation_Do()
'Call MoveElements to align the elements
MoveElements
End Sub
Private Property Get IOperation_MenuString() As String
IOperation_MenuString = "My Align Elements"
End Property
Private Sub IOperation_Redo()
'Call MoveElements to realign the elements
MoveElements
End Sub
Private Sub IOperation_Undo()
'Call ResetElements to move the elements back to their original location
ResetElements
End Sub
Private Sub MoveElements()
Dim pElement As IElement
Dim pTransform2D As ITransform2D
Dim pEnvelope As IEnvelope
Dim pPoint As IPoint
Dim ElementCount As Integer
Set pEnvelope = New Envelope
'Enumerate through all the elements
m_pEnumElement.Reset
Set pElement = m_pEnumElement.Next
Do While Not pElement Is Nothing
If ElementInEditableWorkspace(pElement) Then
ElementCount = ElementCount + 1
ReDim Preserve PointArray(ElementCount) 'resize storage array
pElement.QueryBounds m_pActiveView.ScreenDisplay, pEnvelope
'Select alignment option
Select Case m_AlignType
Case esriTop
Set pPoint = AlignTop(pEnvelope)
Case esriBottom
Set pPoint = AlignBottom(pEnvelope)
Case esriLeft
Set pPoint = AlignLeft(pEnvelope)
Case esriRight
Set pPoint = AlignRight(pEnvelope)
Case Else
End Select
'Flag original element location for invalidation
m_pActiveView.PartialRefresh esriViewGraphics, pElement, Nothing
Set pTransform2D = pElement
pTransform2D.Move pPoint.x, pPoint.y
m_pGraphicsContainer.UpdateElement pElement
'Flag new element location for invalidation
m_pActiveView.PartialRefresh esriViewGraphics, pElement, Nothing
'Add the point to the point array for use by Undo
'Each point holds the dx, dy for a particular element
Set PointArray(ElementCount) = pPoint
End If
'Move onto next element
Set pElement = m_pEnumElement.Next
Loop
End Sub
Private Sub ResetElements()
Dim pElement As IElement
Dim pPoint As IPoint
Dim ElementCount As Integer
Dim pTransform2D As ITransform2D
'Move each element back
m_pEnumElement.Reset
Set pElement = m_pEnumElement.Next
Do While Not pElement Is Nothing
If ElementInEditableWorkspace(pElement) Then
ElementCount = ElementCount + 1
'Point array holds dx, dy
Set pPoint = PointArray(ElementCount)
'Flag original location for invalidation
m_pActiveView.PartialRefresh esriViewGraphics, pElement, Nothing
Set pTransform2D = pElement
pTransform2D.Move - (pPoint.x), - (pPoint.y)
m_pGraphicsContainer.UpdateElement pElement
'Flag new location for invalidation
m_pActiveView.PartialRefresh esriViewGraphics, pElement, Nothing
End If
'Move onto next element
Set pElement = m_pEnumElement.Next
Loop
End Sub
Private Function AlignTop(pEnv As IEnvelope) As IPoint
Dim pPoint As IPoint
Set pPoint = New Point
pPoint.x = 0
pPoint.y = m_pAlignEnv.YMax - pEnv.YMax
Set AlignTop = pPoint
End Function
Private Function AlignBottom(pEnv As IEnvelope) As IPoint
Dim pPoint As IPoint
Set pPoint = New Point
pPoint.x = 0
pPoint.y = m_pAlignEnv.YMin - pEnv.YMin
Set AlignBottom = pPoint
End Function
Private Function AlignLeft(pEnv As IEnvelope) As IPoint
Dim pPoint As IPoint
Set pPoint = New Point
pPoint.x = m_pAlignEnv.XMin - pEnv.XMin
pPoint.y = 0
Set AlignLeft = pPoint
End Function
Private Function AlignRight(pEnv As IEnvelope) As IPoint
Dim pPoint As IPoint
Set pPoint = New Point
pPoint.x = m_pAlignEnv.XMax - pEnv.XMax
pPoint.y = 0
Set AlignRight = pPoint
End Function
'Check if the element belongs to a non-editable workspace
Private Function ElementInEditableWorkspace(pElement As IElement) As Boolean
Dim pAnnoElement As IAnnotationElement
Dim pFeature As IFeature
Dim pDataset As IDataset
Dim pWorkspaceEdit As IWorkspaceEdit
'Check if the element is an annotation element
If Not TypeOf pElement Is IAnnotationElement Then
ElementInEditableWorkspace = True
Exit Function
End If
'We have an annotation element check if the workspace that owns
'it is being edited; if not, don't move the element. On any
'error assume element/feature is editable.
Set pAnnoElement = pElement
Set pFeature = pAnnoElement.Feature
If pFeature Is Nothing Then
ElementInEditableWorkspace = True
Exit Function
End If
Set pDataset = pFeature.Table
If pDataset Is Nothing Then
ElementInEditableWorkspace = True
Exit Function
End If
Set pWorkspaceEdit = pDataset.Workspace
If pWorkspaceEdit Is Nothing Then
ElementInEditableWorkspace = True
Exit Function
End If
'If workspace is not being edited, return false indicating that
'the element cannot be edited/moved/aligned.
If Not pWorkspaceEdit.IsBeingEdited Then
ElementInEditableWorkspace = False
Exit Function
Else
ElementInEditableWorkspace = True
End If
End Function