vba16-8.txt

来自「本书给出了AO的常用的VAB代码 可能是初学者很好的一本参考书」· 文本 代码 · 共 44 行

Private Sub AddRectangle(pEnvelope As IEnvelope)
    ' Draw a rectangle using the
    ' given envelope.
    Dim pMxDocument As IMxDocument
    Dim pPageLayout As IPageLayout
    Dim pActiveView As IActiveView
    Dim pGraphicsContainer As IGraphicsContainer
    Dim pRectangleElement As IElement
    Dim pFillShapeElement As IFillShapeElement
    Dim pFillRGBColor As IRgbColor
    Dim pLineRGBColor As IRgbColor
    Dim pFillSymbol As IFillSymbol
    Dim pLineSymbol As ILineSymbol
    ' Access the page layout.
    Set pMxDocument = Application.Document
    Set pPageLayout = pMxDocument.PageLayout
    Set pActiveView = pPageLayout
    Set pGraphicsContainer = pPageLayout
    ' Set the fill color to be
    ' transparent.
    Set pFillRGBColor = New RgbColor
    pFillRGBColor.Transparency = 0
    Set pFillSymbol = New SimpleFillSymbol
    pFillSymbol.Color = pFillRGBColor
    ' Set the outline color to black.
    Set pLineRGBColor = New RgbColor
    pLineRGBColor.Red = 0
    pLineRGBColor.Green = 0
    pLineRGBColor.Blue = 0
    Set pLineSymbol = New SimpleLineSymbol
    pLineSymbol.Color = pLineRGBColor
    pLineSymbol.Width = 1#
    pFillSymbol.Outline = pLineSymbol
    ' Create the rectangle element.
    Set pRectangleElement = New RectangleElement
    Set pFillShapeElement = pRectangleElement
    pFillShapeElement.Symbol = pFillSymbol
    ' Position the rectangle and
    ' display it on the page layout.
    pRectangleElement.Geometry = pEnvelope
    pRectangleElement.Activate pActiveView.ScreenDisplay
    pGraphicsContainer.AddElement pRectangleElement, 0
End Sub