module1.bas

这是一个非常全的VB+AO二次开发实例集

Attribute VB_Name = "Module1"
Public m_pApplication As IApplication

Public Sub Move(pElementMove As IElement, dx As Long, dy As Long)
    Dim pMxDocument             As IMxDocument
    Dim pTransform2D            As ITransform2D
    Dim pGraphicsContainer      As IGraphicsContainer
    Dim pGraphicsContainerS     As IGraphicsContainerSelect
    On Error GoTo ErrorHandler
    Set pMxDocument = m_pApplication.Document
    Set pGraphicsContainer = pMxDocument.ActiveView
    Set pGraphicsContainerS = pMxDocument.ActiveView
    
    pGraphicsContainer.Reset
    If pGraphicsContainerS.ElementSelectionCount = 0 Then
        Exit Sub
    End If
    '检索所有选中的元素
        Set pTransform2D = pElementMove
        '移动选中的元素
        pTransform2D.Move dx, dy
        pGraphicsContainer.UpdateElement pElementMove
    Exit Sub
ErrorHandler:
    MsgBox Err.Description
End Sub

Private Function AlignPos(pEnvelopeHome As IEnvelope, pEnvelopeMove As IEnvelope, lControl As Long) As IPoint
    Dim pPoint                  As IPoint
    On Error GoTo ErrorHandler

    Set pPoint = New Point
    Select Case lControl
        'align left
        Case 0
            pPoint.X = pEnvelopeHome.XMin - pEnvelopeMove.XMin
            pPoint.Y = 0
        'align center
        Case 1
            pPoint.X = (pEnvelopeHome.XMin + pEnvelopeHome.Width / 2) - (pEnvelopeMove.XMin + pEnvelopeMove.Width / 2)
            pPoint.Y = 0
        'align right
        Case 2
            pPoint.X = pEnvelopeHome.XMax - pEnvelopeMove.XMax
            pPoint.Y = 0
        'align top
        Case 3
            pPoint.X = 0
            pPoint.Y = pEnvelopeHome.YMax - pEnvelopeMove.YMax
        'align vertical center
        Case 4
            pPoint.X = 0
            pPoint.Y = (pEnvelopeHome.YMin + pEnvelopeHome.Height / 2) - (pEnvelopeMove.YMin + pEnvelopeMove.Height / 2)
        'align bottom
        Case 5
            pPoint.X = 0
            pPoint.Y = pEnvelopeHome.YMin - pEnvelopeMove.YMin
    End Select
    Set AlignPos = pPoint
    Exit Function
ErrorHandler:
    MsgBox Err.Description
End Function

Public Function Align(lControl As Long)
    Dim pMxDocument             As IMxDocument
    Dim pGraphicsContainerS     As IGraphicsContainerSelect
    Dim pElementHome            As IElement
    Dim pElementMove            As IElement
    Dim pPoint                  As IPoint
    Dim pEnumElement            As IEnumElement
    Dim pEnvelopeHome           As IEnvelope
    Dim pEnvelopeMove           As IEnvelope
    On Error GoTo ErrorHandler
    
    Set pMxDocument = m_pApplication.Document
    Set pGraphicsContainerS = pMxDocument.ActiveView
    If pGraphicsContainerS.ElementSelectionCount = 0 Then
        Exit Function
    End If
    Set pEnumElement = pGraphicsContainerS.SelectedElements
    pEnumElement.Reset
    '设定
    Set pEnvelopeHome = New Envelope
    Set pEnvelopeMove = New Envelope
    Set pElementHome = pEnumElement.Next
    '得到元素所显示的Envelope
    pElementHome.QueryBounds pMxDocument.ActiveView.ScreenDisplay, pEnvelopeHome
    Set pElementMove = pEnumElement.Next
    pElementMove.QueryBounds pMxDocument.ActiveView.ScreenDisplay, pEnvelopeMove
    
    Do While Not pElementMove Is Nothing
        Set pPoint = AlignPos(pEnvelopeHome, pEnvelopeMove, lControl)
        '移动
        Move pElementMove, pPoint.X, pPoint.Y
        
        Set pElementMove = pEnumElement.Next
        If Not pElementMove Is Nothing Then
            pElementMove.QueryBounds pMxDocument.ActiveView.ScreenDisplay, pEnvelopeMove
        End If
    Loop
    
    pMxDocument.ActiveView.Refresh
    Exit Function
ErrorHandler:
    MsgBox Err.Description

End Function