?? vba16-6.txt
字號:
Public Function PlaceOverviewMapFrame() As IElement
' Position the overview map frame
' in the upper rigth corner.
Dim pMxDocument As IMxDocument
Dim pPageLayout As IPageLayout
Dim pPage As IPage
Dim pActiveView As IActiveView
Dim dblPageWidth As Double
Dim dblPageHeight As Double
Dim dblMargin As Double
Dim dblFrameWidth As Double
Dim dblFrameHeight As Double
Dim pElement As IElement
Dim pEnvelope As IEnvelope
Dim pMapFrame As IMapFrame
Dim pDetailMapFrame As IMapFrame
Dim pTransform2d As ITransform2D
Dim pPoint As IPoint
Dim dblXMove As Double
Dim dblYMove As Double
Dim pLocatorRectangle As ILocatorRectangle
Dim pBorder As IBorder
Dim pSymbolBorder As ISymbolBorder
Dim pLineSymbol As ILineSymbol
Dim pRGBColor As IRgbColor
' Get the page size.
Set pMxDocument = Application.Document
Set pPageLayout = pMxDocument.PageLayout
Set pActiveView = pPageLayout
Set pPage = pPageLayout.Page
pPage.QuerySize dblPageWidth, dblPageHeight
dblMargin = c_dblMargin
' Overview map frame's new width
' and height are 2 inches.
dblFrameWidth = 2
dblFrameHeight = 2
' Access the overview map frame.
Set pElement = GetMapFrameByName("OVERVIEW")
If pElement Is Nothing Then
MsgBox "Missing Overview map."
Set PlaceOverviewMapFrame = Nothing
Exit Function
End If
' Get the map frame's
' current size.
Set pEnvelope = New Envelope
pElement.QueryBounds pActiveView.ScreenDisplay, _
pEnvelope
Set pMapFrame = pElement
pMapFrame.ExtentType = esriExtentDefault
' Resize and move the overview map frame.
Set pTransform2d = pMapFrame
Set pPoint = New Point
pPoint.X = pEnvelope.XMin
pPoint.Y = pEnvelope.YMax
With pTransform2d
.Scale pPoint, _
dblFrameWidth / pEnvelope.Width, _
dblFrameHeight / pEnvelope.Height
End With
dblXMove = dblPageWidth - _
(dblMargin + dblFrameWidth) - pEnvelope.XMin
dblYMove = (dblPageHeight - dblMargin) - _
pEnvelope.YMax
pTransform2d.Move dblXMove, dblYMove
' Add the extent box to the overview map.
' Change the extent rectangle
' color to red.
pMapFrame.RemoveAllLocatorRectangles
Set pLocatorRectangle = New LocatorRectangle
Set pDetailMapFrame = GetMapFrameByName("DETAIL")
Set pLocatorRectangle.MapFrame = pDetailMapFrame
Set pBorder = pLocatorRectangle.Border
Set pSymbolBorder = pBorder
Set pLineSymbol = pSymbolBorder.LineSymbol
Set pRGBColor = New RgbColor
pRGBColor.Red = 255
pRGBColor.Green = 0
pRGBColor.Blue = 0
pLineSymbol.Color = pRGBColor
pLineSymbol.Width = 1.5
pSymbolBorder.LineSymbol = pLineSymbol
pLocatorRectangle.Border = pSymbolBorder
pMapFrame.AddLocatorRectangle pLocatorRectangle
' Done
Set PlaceOverviewMapFrame = pElement
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -