VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsCreatePlanProfile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Implements ICommand

' Constants
Private Const c_ModuleFileName = "PlanAndProfile.clsCreatePlanProfile"
Private Const cPI = 3.14159265358979

' Variables
Dim m_pApplication As IApplication
Dim m_pMxDoc As IMxDocument
Dim m_ZMin As Double
Dim m_ZMax As Double
Dim m_HeightPct As Double
Dim m_GridCount As Long
Dim m_MapGapPct As Double
Dim m_Verticals As Boolean
Dim m_TextInfo As Boolean

Private Sub Class_Terminate()
    Set m_pApplication = Nothing
    Set m_pMxDoc = Nothing
End Sub

Private Property Get ICommand_Enabled() As Boolean
' Test whether the Create Plan Profile button should be enabled or disabled
    Dim pMap As IMap
    Dim bInLayoutMode As Boolean
    Dim bFeaturesSelected As Boolean
    Dim bFeaturesZAware As Boolean
    Dim pFeature As IFeature
    Dim pEnumFeat As IEnumFeature
    Dim pZAWare As IZAware
    Dim sDisabledMsg As String
    
    On Error GoTo ErrorHandler
    
    ' Test for 'In Layout Mode'
    bInLayoutMode = InLayoutMode(m_pMxDoc)
    If Not bInLayoutMode Then sDisabledMsg = "- Not in Layout mode" & vbCrLf
    ' Test for 'Feature/s Selected'
    Set pMap = m_pMxDoc.FocusMap
    bFeaturesSelected = (pMap.SelectionCount > 0)
    If bFeaturesSelected Then
        bFeaturesZAware = True
        Set pEnumFeat = pMap.FeatureSelection
        Set pFeature = pEnumFeat.Next
        While (Not pFeature Is Nothing)
            ' Test for all selected features 'Supporting And Being ZAware'
            If TypeOf pFeature.Shape Is IZAware Then
                Set pZAWare = pFeature.Shape
                bFeaturesZAware = bFeaturesZAware And pZAWare.ZAware
                If (Not pZAWare.ZAware) And (InStr(sDisabledMsg, pFeature.Class.AliasName) <= 0) Then
                    sDisabledMsg = sDisabledMsg & "- '" & pFeature.Class.AliasName _
                        & "' feature class is not Z-Aware" & vbCrLf
                End If
            Else
                bFeaturesZAware = False
                sDisabledMsg = sDisabledMsg & "- '" & pFeature.Class.AliasName _
                    & "' feature class does not support IZAware" & vbCrLf
            End If
            Set pFeature = pEnumFeat.Next
        Wend
    Else
        sDisabledMsg = sDisabledMsg & "- No features selected"
    End If
    Set pMap = Nothing
    
    ' Set the enabled property
    ICommand_Enabled = bInLayoutMode And bFeaturesSelected And bFeaturesZAware
    
    ' Update the form properties, so user can identify the problem (if one exists)
    If ICommand_Enabled Then
        frmProperties.DisabledMessage = ""
        frmProperties.DisabledStatus = False
    Else
        frmProperties.DisabledMessage = sDisabledMsg
        frmProperties.DisabledStatus = True
    End If
    
    Exit Property
ErrorHandler:
    HandleError True, "ICommand_Enabled " & c_ModuleFileName & " " _
        & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 2
End Property
 
Private Property Get ICommand_Checked() As Boolean

End Property
 
Private Property Get ICommand_Name() As String
    ICommand_Name = "PlanProfile_Create"
End Property
 
Private Property Get ICommand_Caption() As String
    ICommand_Caption = "Create Plan Profile"
End Property
 
Private Property Get ICommand_Tooltip() As String
    ICommand_Tooltip = "Create Plan Profile"
End Property
 
Private Property Get ICommand_Message() As String
    ICommand_Message = "Create a Plan and Profile graphic based on current selection"
End Property
 
Private Property Get ICommand_HelpFile() As String

End Property
 
Private Property Get ICommand_HelpContextID() As Long

End Property
 
Private Property Get ICommand_Bitmap() As esriCore.OLE_HANDLE
    ICommand_Bitmap = frmIcons.picPlanProfile
End Property
 
Private Property Get ICommand_Category() As String
    ICommand_Category = "Samples"
End Property
 
Private Sub ICommand_OnCreate(ByVal hook As Object)
    On Error GoTo ErrorHandler
    
    ' Init our variables
    Set m_pApplication = hook
    Set m_pMxDoc = m_pApplication.Document
    
    Exit Sub
ErrorHandler:
    HandleError True, "ICommand_OnCreate " & c_ModuleFileName & " " _
        & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 2
End Sub
 
Private Sub ICommand_OnClick()
    Dim pLine As ILine
    Dim pCls As New clsRotateMap
        
    ' Init
    On Error GoTo ErrorHandler
    Screen.MousePointer = vbHourglass
    
    ' Delete the old Plan/Profile as specified, if it exists
    If frmProperties.AutoReplace Then
        Select Case frmProperties.AutoReplaceType
            Case 0: ClearLayout m_pMxDoc, c_ElementPrefix & c_ProfilePrefix
            Case 1: ClearLayout m_pMxDoc, c_ElementPrefix & c_TextBoxPrefix
            Case 2: ClearLayout m_pMxDoc, c_ElementPrefix
        End Select
    End If
    
    ' If required, attempt to rotate map automatically
    If frmProperties.AutoRotate Then
        Set pLine = FindFurtherestPoints
        If Not pLine Is Nothing Then
            pCls.RotateMap pLine, m_pMxDoc.FocusMap
            Set pCls = Nothing
        End If
    End If
    
    ' Get the envelope extents (in map units and in page units)
    If Not GetMapAndPageEnvelopes(m_pMxDoc, m_pApplication) Then
        MsgBox "Could not populate the Map and Page Envelope information."
        Screen.MousePointer = vbDefault
        Exit Sub
    End If
    
    ' Get our variables
    m_ZMin = frmProperties.MinZ
    m_ZMax = frmProperties.MaxZ
    m_HeightPct = frmProperties.PercentageSize
    m_GridCount = frmProperties.GridCount
    m_MapGapPct = frmProperties.MapGapPercentage
    m_Verticals = frmProperties.Verticals
    m_TextInfo = frmProperties.TextInfo
    
    ' Need to check we have some values
    If m_ZMin = 0 Or m_ZMax = 0 Or m_HeightPct = 0 Or m_GridCount = 0 Then
        MsgBox "WARNING: There is at least one invalid *required*" & vbCrLf & "Plan and Profile setting." _
            & vbCrLf & vbCrLf & "Please verify non-zero settings for:" & vbCrLf & " - Z Minimum" _
            & vbTab & "- Size (%Mapframe)" & vbCrLf & " - Z Maximum" & vbTab & "- No of Gridlines", _
            vbInformation, "Plan and Profile"
        Screen.MousePointer = vbDefault
        Exit Sub
    End If
    
    ' Make the Profile Box (inc. tick mark lines/text and feature profiles, etc)
    CreateProfileBox
    
    ' Group the graphics (so user can move entire thing)
    GroupGraphicsWithPrefix m_pMxDoc, c_ElementPrefix & c_ProfilePrefix
    GroupGraphicsWithPrefix m_pMxDoc, c_ElementPrefix & c_TextBoxPrefix
    
    ' Refresh the view
    m_pApplication.StatusBar.Message(0) = ""
    m_pMxDoc.ActiveView.Refresh
    Screen.MousePointer = vbDefault
    
    Exit Sub
    Resume
ErrorHandler:
    HandleError True, "ICommand_OnClick " & c_ModuleFileName & " " _
        & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 2
    Screen.MousePointer = vbDefault
End Sub

Private Sub CreateProfileBox()
' Create bounding box, tick marks, text and feature profiles
    Dim dPageYTop As Double
    Dim dPageRngX As Double, dPageRngY As Double
    Dim dBndBoxX1 As Double, dBndBoxY1 As Double
    Dim dBndBoxX2 As Double, dBndBoxY2 As Double
    Dim dBndBoxRngY As Double
    Dim dTemp As Double, dTemp2 As Double
    Dim dTemp3 As Double, dTemp4 As Double
    Dim dZIncrement As Double
    Dim iMarkEach As Integer
    Dim dFontSize As Double
    Dim sFontName As String
    Dim pMap As IMap
    Dim pGC As IGraphicsContainer
    Dim pRGB As IRgbColor
    Dim pRGBDarkGrey As IRgbColor, pRGBLightGrey As IRgbColor
    Dim lLoop As Long
    Dim pEnumFeat As IEnumFeature
    Dim pFeature As IFeature
    Dim pPoint As IPoint
    Dim pPntColl As IPointCollection
    Dim lPntFailsZ As Long, lLineFailsZ As Long
    Dim lPntFailsX As Long, lLineFailsX As Long
    Dim pActiveView As IActiveView
    Dim pDisplayTransform As IDisplayTransformation
    Dim dLayoutX As Double, dLayoutY As Double
    Dim lDevX As Long, lDevY As Long
    Dim pSymbol As ISymbol, pMarkerSym As ISimpleMarkerSymbol
    Dim pFL As IFeatureLayer
    Dim pGeoFL As IGeoFeatureLayer
    Dim pFeatureRenderer As IFeatureRenderer
    Dim sMsg As String
    
    ' Init our ESRI objects
    m_pApplication.StatusBar.Message(0) = "Creating profile ..."
    Set pMap = m_pMxDoc.FocusMap
    Set pGC = m_pMxDoc.PageLayout
    Set pRGBDarkGrey = BuildRGB(40, 40, 40)
    Set pRGBLightGrey = BuildRGB(200, 200, 200)
    iMarkEach = frmProperties.MarkEach
    sFontName = frmProperties.TextFontNameAxis
    dFontSize = frmProperties.TextFontSizeAxis
    
    ' Init our working Bounding Box coords (in Layout units)
    dPageYTop = m_pPageUnitsEnvelope.YMax
    dPageRngX = (m_pPageUnitsEnvelope.XMax - m_pPageUnitsEnvelope.XMin)
    dPageRngY = (m_pPageUnitsEnvelope.YMax - m_pPageUnitsEnvelope.YMin)
    dBndBoxX1 = m_pPageUnitsEnvelope.XMin
    dBndBoxY1 = m_pPageUnitsEnvelope.YMin - (m_HeightPct / 100 * dPageRngY) - (m_MapGapPct / 100 * dPageRngY)
    dBndBoxX2 = m_pPageUnitsEnvelope.XMax
    dBndBoxY2 = m_pPageUnitsEnvelope.YMin - (m_MapGapPct / 100 * dPageRngY)
    dBndBoxRngY = (dBndBoxY2 - dBndBoxY1)
    
    ' Create bounding box
    GenerateLineElement dBndBoxX1, dBndBoxY1, dBndBoxX1, dBndBoxY2, _
        esriSLSSolid, 2, pRGBDarkGrey, c_ProfilePrefix & "Frame", pGC
    GenerateLineElement dBndBoxX1, dBndBoxY2, dBndBoxX2, dBndBoxY2, _
        esriSLSSolid, 2, pRGBDarkGrey, c_ProfilePrefix & "Frame", pGC
    GenerateLineElement dBndBoxX2, dBndBoxY2, dBndBoxX2, dBndBoxY1, _
        esriSLSSolid, 2, pRGBDarkGrey, c_ProfilePrefix & "Frame", pGC
    GenerateLineElement dBndBoxX2, dBndBoxY1, dBndBoxX1, dBndBoxY1, _
        esriSLSSolid, 2, pRGBDarkGrey, c_ProfilePrefix & "Frame", pGC
    
    ' Create the tick lines and numbers (Dark Grey)
    dZIncrement = (m_ZMax - m_ZMin) / m_GridCount
    GenerateTextElement dBndBoxX1 - (0.01 * dPageRngX), dBndBoxY1, _
        Format(m_ZMin, cFormatOneDec), esriTHARight, esriTVACenter, dFontSize, 0, sFontName, _
        pRGBDarkGrey, c_ProfilePrefix & "TickNumber", pGC     ' Minimum Z Value
    GenerateTextElement dBndBoxX1 - (0.01 * dPageRngX), dBndBoxY2, _
        Format(m_ZMax, cFormatOneDec), esriTHARight, esriTVACenter, dFontSize, 0, sFontName, _
        pRGBDarkGrey, c_ProfilePrefix & "TickNumber", pGC     ' Maximum Z Value
    For lLoop = 1 To (m_GridCount - 1) Step 1
        dTemp = dBndBoxY1 + ((lLoop / m_GridCount) * (dBndBoxY2 - dBndBoxY1))
        GenerateLineElement dBndBoxX1, dTemp, dBndBoxX2, dTemp, _
            esriSLSDot, 0.5, pRGBDarkGrey, c_ProfilePrefix & "TickLine", pGC
        If (lLoop Mod iMarkEach) = 0 Then   ' Every nth between Z Value (from the bottom)
            GenerateTextElement dBndBoxX1 - (0.01 * dPageRngX), dTemp, _
                Format((lLoop * dZIncrement) + m_ZMin, cFormatOneDec), esriTHARight, _
                esriTVACenter, dFontSize, 0, sFontName, pRGBDarkGrey, c_ProfilePrefix & "TickNumber", pGC
        End If
    Next
    
    ' Add the feature profiles
    Set pActiveView = pMap
    Set pDisplayTransform = pActiveView.ScreenDisplay.DisplayTransformation
    Set pEnumFeat = pMap.FeatureSelection
    pEnumFeat.Reset
    Set pFeature = pEnumFeat.Next
    While Not pFeature Is Nothing
        ' Process points
        If TypeOf pFeature.Shape Is IPoint Then
            Set pPoint = pFeature.Shape
            ' Get the layout position of this feature
            pDisplayTransform.FromMapPoint pPoint, lDevX, lDevY
            ConvertDeviceToLayout lDevX, lDevY, dLayoutX, dLayoutY
            ' Calc the ratio-ed position of the Z-Value
            dTemp2 = dBndBoxY1 + (((pPoint.Z - m_ZMin) / (m_ZMax - m_ZMin)) * dBndBoxRngY)
            ' Check if in bounds (Z)
            If ((pPoint.Z < m_ZMin) Or (pPoint.Z > m_ZMax)) Then
                lPntFailsZ = lPntFailsZ + 1
            ' Check if in bounds (X)
            ElseIf ((dLayoutX < dBndBoxX1) Or (dLayoutX > dBndBoxX2)) Then
                lPntFailsX = lPntFailsX + 1
            Else
                Set pRGB = New RgbColor
                pRGB.RGB = pRGBDarkGrey.RGB   ' Init to dark grey
                Set pFL = FindFeatureLayer(pFeature.Class.AliasName)
                If Not pFL Is Nothing Then
                    Set pGeoFL = pFL
                    Set pFeatureRenderer = pGeoFL.Renderer
                    Set pSymbol = pFeatureRenderer.SymbolByFeature(pFeature)
                    Set pRGB = GetRGBFromSymbol(pSymbol)
                End If
                Select Case frmProperties.SymbolisePoint
                    Case 0:
                        ' Symbol
                        GeneratePointElement dLayoutX, dTemp2, esriSMSCircle, 8, pRGB, _
                            c_ProfilePrefix & "PntFeature", pGC, pSymbol
                    Case 1:
                        ' Color
                        GeneratePointElement dLayoutX, dTemp2, esriSMSCircle, 8, pRGB, _
                            c_ProfilePrefix & "PntFeature", pGC
                    Case 2:
                        ' None
                        GeneratePointElement dLayoutX, dTemp2, esriSMSCircle, 8, pRGBDarkGrey, _
                            c_ProfilePrefix & "PntFeature", pGC
                End Select
                If m_Verticals Then
                    GenerateLineElement dLayoutX, dBndBoxY1, dLayoutX, dPageYTop, esriSLSSolid, _
                        0.5, pRGBLightGrey, c_ProfilePrefix & "VertLine", pGC
                End If
            End If
        ' Process lines
        ElseIf TypeOf pFeature.Shape Is IPointCollection Then
            Set pPntColl = pFeature.Shape
            For lLoop = 0 To (pPntColl.PointCount - 2)
                Set pPoint = pPntColl.Point(lLoop)
                ' Get the layout position of this feature
                pDisplayTransform.FromMapPoint pPoint, lDevX, lDevY
                ConvertDeviceToLayout lDevX, lDevY, dLayoutX, dLayoutY
                dTemp = dLayoutX
                ' Calc the ratio-ed position of the Z-Value
                dTemp2 = dBndBoxY1 + (((pPoint.Z - m_ZMin) / (m_ZMax - m_ZMin)) * dBndBoxRngY)
                If (pPoint.Z < m_ZMin) Or (pPoint.Z > m_ZMax) Then
                    lLineFailsZ = lLineFailsZ + 1
                ' Check if in bounds (X)
                ElseIf ((dTemp < dBndBoxX1) Or (dTemp > dBndBoxX2)) Then
                    lPntFailsX = lPntFailsX + 1
                Else
                    Set pPoint = pPntColl.Point(lLoop + 1)
                    ' Get the layout position of this feature
                    pDisplayTransform.FromMapPoint pPoint, lDevX, lDevY
                    ConvertDeviceToLayout lDevX, lDevY, dLayoutX, dLayoutY
                    dTemp3 = dLayoutX
                    ' Calc the ratio-ed position of the Z-Value
                    dTemp4 = dBndBoxY1 + (((pPoint.Z - m_ZMin) / (m_ZMax - m_ZMin)) * dBndBoxRngY)
                    If (pPoint.Z < m_ZMin) Or (pPoint.Z > m_ZMax) Then
                        lLineFailsZ = lLineFailsZ + 1
                    ' Check if in bounds (X)
                    ElseIf ((dTemp3 < dBndBoxX1) Or (dTemp3 > dBndBoxX2)) Then
                        lPntFailsX = lPntFailsX + 1
                    Else
                        Set pRGB = New RgbColor
                        pRGB.RGB = pRGBDarkGrey.RGB   ' Init to dark grey
                        Set pFL = FindFeatureLayer(pFeature.Class.AliasName)
                        If Not pFL Is Nothing Then
                            Set pGeoFL = pFL
                            Set pFeatureRenderer = pGeoFL.Renderer
                            Set pSymbol = pFeatureRenderer.SymbolByFeature(pFeature)
                            Set pRGB = GetRGBFromSymbol(pSymbol)
                        End If
                        Select Case frmProperties.SymboliseLine
                            Case 0:
                                ' Color
                                GenerateLineElement dTemp, dTemp2, dTemp3, dTemp4, esriSLSSolid, _
                                    1, pRGB, c_ProfilePrefix & "LineFeature", pGC
                            Case 1:
                                ' None
                                GenerateLineElement dTemp, dTemp2, dTemp3, dTemp4, esriSLSSolid, _
                                    1, pRGBDarkGrey, c_ProfilePrefix & "LineFeature", pGC
                        End Select
                    End If
                End If
            Next
        End If
        ' Move to next feature
        Set pFeature = pEnumFeat.Next
    Wend
    
    ' If required, add the text stuff (from ini file)
    If m_TextInfo Then
        'CreateTextInfo dBndBoxX1, dBndBoxX2, dBndBoxY1, pGC
        CreateTextInfo m_pPrintablePageUnits.XMin, m_pPrintablePageUnits.XMax, _
            m_pPrintablePageUnits.YMin, pGC
    End If
    
    ' Advise of any errors / omitted features
    sMsg = ""
    If lPntFailsX > 0 Or lLineFailsX > 0 Then
        sMsg = " - " & (lPntFailsX + lLineFailsX) & " points/line segments were outside the " _
            & "map frame's X-Range" & vbCrLf
    End If
    If lPntFailsZ > 0 Or lLineFailsZ > 0 Then
        sMsg = sMsg & " - " & (lPntFailsZ + lLineFailsZ) & " points/line segments were outside the " _
            & "Z-Range" & vbCrLf
    End If
    If Len(sMsg) > 0 Then
        MsgBox "WARNING: Not all selected features were added to the Plan and Profile." & vbCrLf _
            & sMsg & vbCrLf & vbCrLf & "Please verify your selection and the settings in the " _
            & "Properties dialog.", vbInformation, "Plan And Profile"
    End If
    
End Sub

Public Sub ConvertDeviceToLayout(X As Long, Y As Long, outX As Double, outY As Double)
'This routine takes device units and returns layout units
    Dim pMxDoc As IMxDocument
    Dim pPageLayout As IPageLayout
    Dim pPage As IPage
    Dim pDisplayTransformation As IDisplayTransformation
    Dim pActiveView As IActiveView
    Dim pPoint As IPoint
    
    'Convert the device units to layout units
    Set pMxDoc = m_pApplication.Document
    Set pPageLayout = pMxDoc.PageLayout
    Set pActiveView = pPageLayout
    Set pDisplayTransformation = pActiveView.ScreenDisplay.DisplayTransformation
    Set pPoint = pDisplayTransformation.ToMapPoint(X, Y)
    ' Return
    outX = pPoint.X
    outY = pPoint.Y
End Sub

Private Function FindFeatureLayer(sFeatureClassAliasName As String) As IFeatureLayer
' Returns a feature layer based on the feature class alias name
    Dim pFLayer As IFeatureLayer
    Dim i As Integer
    ' Init
    Set FindFeatureLayer = Nothing
    ' For each layer
    For i = 0 To m_pMxDoc.FocusMap.LayerCount - 1
        If TypeOf m_pMxDoc.FocusMap.Layer(i) Is IFeatureLayer Then
            Set pFLayer = m_pMxDoc.FocusMap.Layer(i)
            ' Look for a match
            If UCase(sFeatureClassAliasName) = UCase(pFLayer.FeatureClass.AliasName) Then
                Set FindFeatureLayer = pFLayer
                Exit For
            End If
        End If
    Next i
End Function

Private Sub CreateTextInfo(dMinX As Double, dMaxX As Double, dMinY As Double, pGC As IGraphicsContainer)
' Adds the three text boxes (using the INI file text) to the base of the printable envelope
    Dim colAllLines As Collection
    Dim sLine As String
    Dim sTitle As String
    Dim sGeneral As String
    Dim sDrawingInfo As String
    Dim iCurrBox As Integer
    Dim lLoop As Long
    Dim dHeight As Double
    Dim pRGBDarkGrey As IRgbColor
    Dim dFontSize As Double
    Dim dFontName As String
    ' Init
    m_pApplication.StatusBar.Message(0) = "Adding text boxes from INI file ..."
    Set colAllLines = Read_File(frmProperties.TextINIFilename)
    If colAllLines Is Nothing Then
        Exit Sub
    End If
    dFontName = frmProperties.TextFontName
    dFontSize = frmProperties.TextFontSize
    iCurrBox = 0
    Set pRGBDarkGrey = BuildRGB(40, 40, 40)
    ' Get the three strings (including any return characters)
    For lLoop = 1 To colAllLines.Count
        sLine = colAllLines.Item(lLoop)
        If Len(sLine) = 0 Then sLine = " "
        If Left(sLine, 1) <> "#" Then
            If (Left(sLine, 2) = "/t") Or (Left(sLine, 2) = "/g") Or (Left(sLine, 2) = "/d") Then
                Select Case (Left(sLine, 2))
                    Case "/t": iCurrBox = 1
                    Case "/g": iCurrBox = 2
                    Case "/d": iCurrBox = 3
                End Select
            Else
                If (iCurrBox = 1) Then              'Title
                    sTitle = sTitle & vbCrLf & sLine
                ElseIf (iCurrBox = 2) Then          'General Info
                    sGeneral = sGeneral & vbCrLf & sLine
                ElseIf (iCurrBox = 3) Then          'Drawing Info
                    sDrawingInfo = sDrawingInfo & vbCrLf & sLine
                End If
            End If
        End If
    Next
    ' Calc box sizes
    Dim dWidth As Double, dOffset As Double
    dWidth = (dMaxX - dMinX)
    dHeight = dWidth * 0.1   ' Keep a 10:1 raio for width/height of marginalia boxes
    dOffset = dHeight * 0.1  ' Leave 10% gap at top of box before adding text
    ' Create bounding boxes
    GenerateLineElement dMinX, dMinY, dMinX + dWidth, dMinY, _
        esriSLSSolid, 1, pRGBDarkGrey, c_TextBoxPrefix & "TextFrame", pGC
    GenerateLineElement dMinX + dWidth, dMinY, dMinX + dWidth, dMinY + dHeight, _
        esriSLSSolid, 1, pRGBDarkGrey, c_TextBoxPrefix & "TextFrame", pGC
    GenerateLineElement dMinX + dWidth, dMinY + dHeight, dMinX, dMinY + dHeight, _
        esriSLSSolid, 1, pRGBDarkGrey, c_TextBoxPrefix & "TextFrame", pGC
    GenerateLineElement dMinX, dMinY + dHeight, dMinX, dMinY, _
        esriSLSSolid, 1, pRGBDarkGrey, c_TextBoxPrefix & "TextFrame", pGC
    GenerateLineElement dMinX + (0.3 * dWidth), dMinY, dMinX + (0.3 * dWidth), dMinY + dHeight, _
        esriSLSSolid, 1, pRGBDarkGrey, c_TextBoxPrefix & "TextFrame", pGC
    GenerateLineElement dMinX + (0.7 * dWidth), dMinY, dMinX + (0.7 * dWidth), dMinY + dHeight, _
        esriSLSSolid, 1, pRGBDarkGrey, c_TextBoxPrefix & "TextFrame", pGC
    ' Create the text
    GenerateTextElement dMinX + (0.15 * dWidth), dMinY + dHeight - dOffset, _
        sTitle, esriTHACenter, esriTVATop, dFontSize, 0, dFontName, _
        pRGBDarkGrey, c_TextBoxPrefix & "Title", pGC
    GenerateTextElement dMinX + (0.5 * dWidth), dMinY + dHeight - dOffset, _
        sGeneral, esriTHACenter, esriTVATop, dFontSize, 0, dFontName, _
        pRGBDarkGrey, c_TextBoxPrefix & "General", pGC
    GenerateTextElement dMinX + (0.85 * dWidth), dMinY + dHeight - dOffset, _
        sDrawingInfo, esriTHACenter, esriTVATop, dFontSize, 0, dFontName, _
        pRGBDarkGrey, c_TextBoxPrefix & "DrawingInfo", pGC
End Sub

Private Function FindFurtherestPoints() As esriCore.ILine
' Loops thru the selected point and line features and returns a single segment line
'  between the two furtherest points
    Dim pMap As IMap
    Dim pEnumFeat As IEnumFeature
    Dim pFeature As IFeature
    Dim pPoint As IPoint
    Dim pColl As New Collection
    Dim pPntColl As IPointCollection
    Dim lLoop As Long, lLoop2 As Long
    Dim pTmpLine As ILine
    Dim dMaxLength As Double
    
    ' Init and get the selection
    m_pApplication.StatusBar.Message(0) = "Finding furtherest points ..."
    dMaxLength = -1
    Set pMap = m_pMxDoc.FocusMap
    Set pEnumFeat = pMap.FeatureSelection
    pEnumFeat.Reset
    ' Get all the selected features as collection of points
    Set pFeature = pEnumFeat.Next
    While Not pFeature Is Nothing
        ' Process points
        If TypeOf pFeature.Shape Is IPoint Then
            Set pPoint = pFeature.Shape
            pColl.Add pPoint
        ' Process lines
        ElseIf TypeOf pFeature.Shape Is IPointCollection Then
            Set pPntColl = pFeature.Shape
            For lLoop = 0 To (pPntColl.PointCount - 1)
                Set pPoint = pPntColl.Point(lLoop)
                pColl.Add pPoint
            Next
        End If
        Set pFeature = pEnumFeat.Next
    Wend
    ' Compare all pairs of points for longest line
    For lLoop = 1 To (pColl.Count - 1)
        For lLoop2 = lLoop To pColl.Count
            Set pTmpLine = New esriCore.Line
            pTmpLine.PutCoords pColl(lLoop), pColl(lLoop2)
            If pTmpLine.Length > dMaxLength Then
                dMaxLength = pTmpLine.Length
                Set FindFurtherestPoints = pTmpLine
            End If
        Next
    Next
    ' If first point is 'right' of second, swap them
    If Not FindFurtherestPoints Is Nothing Then
        If FindFurtherestPoints.FromPoint.X > FindFurtherestPoints.ToPoint.X Then
            FindFurtherestPoints.ReverseOrientation
        End If
    End If
End Function

Private Function GetRGBFromSymbol(pSymbol As ISymbol) As IRgbColor
' Return the RGB Color for all co-classes of the ISymbol interface (that have the property)
    Dim pRGB As IRgbColor
    On Error GoTo eh
    Set pRGB = New RgbColor
    If TypeOf pSymbol Is ICharacterMarkerSymbol Then
        Dim pCMS As ICharacterMarkerSymbol
        Set pCMS = pSymbol
        pRGB.RGB = pCMS.Color.RGB
    ElseIf TypeOf pSymbol Is IMarkerFillSymbol Then
        Dim pMFS As IMarkerFillSymbol
        Set pMFS = pSymbol
        pRGB.RGB = pMFS.Color.RGB
    ElseIf TypeOf pSymbol Is IMarkerLineSymbol Then
        Dim pMLS As IMarkerLineSymbol
        Set pMLS = pSymbol
        pRGB.RGB = pMLS.Color.RGB
    ElseIf TypeOf pSymbol Is IMultiLayerMarkerSymbol Then
        Dim pMLMS As IMultiLayerMarkerSymbol
        Set pMLMS = pSymbol
        pRGB.RGB = pMLMS.Color.RGB
    ElseIf TypeOf pSymbol Is IPictureFillSymbol Then
        Dim pPFS As IPictureFillSymbol
        Set pPFS = pSymbol
        pRGB.RGB = pPFS.Color.RGB
    ElseIf TypeOf pSymbol Is IPictureMarkerSymbol Then
        Dim pPMS As IPictureMarkerSymbol
        Set pPMS = pSymbol
        pRGB.RGB = pPMS.Color.RGB
    ElseIf TypeOf pSymbol Is ISimpleMarkerSymbol Then
        Dim pSMS As ISimpleMarkerSymbol
        Set pSMS = pSymbol
        pRGB.RGB = pSMS.Color.RGB
    ElseIf TypeOf pSymbol Is IArrowMarkerSymbol Then
        Dim pAMS As IArrowMarkerSymbol
        Set pAMS = pSymbol
        pRGB.RGB = pAMS.Color.RGB
    ElseIf TypeOf pSymbol Is ICartographicLineSymbol Then
        Dim pCls As ICartographicLineSymbol
        Set pCls = pSymbol
        pRGB.RGB = pCls.Color.RGB
    ElseIf TypeOf pSymbol Is IDotDensityFillSymbol Then
        Dim pDDFS As IDotDensityFillSymbol
        Set pDDFS = pSymbol
        pRGB.RGB = pDDFS.Color.RGB
    ElseIf TypeOf pSymbol Is IGradientFillSymbol Then
        Dim pGFS As IGradientFillSymbol
        Set pGFS = pSymbol
        pRGB.RGB = pGFS.Color.RGB
    ElseIf TypeOf pSymbol Is IHashLineSymbol Then
        Dim pHLS As IHashLineSymbol
        Set pHLS = pSymbol
        pRGB.RGB = pHLS.Color.RGB
    ElseIf TypeOf pSymbol Is ILineFillSymbol Then
        Dim pLFS As ILineFillSymbol
        Set pLFS = pSymbol
        pRGB.RGB = pLFS.Color.RGB
    ElseIf TypeOf pSymbol Is IMultiLayerFillSymbol Then
        Dim pMLFS As IMultiLayerFillSymbol
        Set pMLFS = pSymbol
        pRGB.RGB = pMLFS.Color.RGB
    ElseIf TypeOf pSymbol Is IPictureFillSymbol Then
        Dim pPicFS As IPictureFillSymbol
        Set pPicFS = pSymbol
        pRGB.RGB = pPicFS.Color.RGB
    ElseIf TypeOf pSymbol Is ISimpleFillSymbol Then
        Dim pSFS As ISimpleFillSymbol
        Set pSFS = pSymbol
        pRGB.RGB = pSFS.Color.RGB
    ElseIf TypeOf pSymbol Is ISimpleLineSymbol Then
        Dim pSLS As ISimpleLineSymbol
        Set pSLS = pSymbol
        pRGB.RGB = pSLS.Color.RGB
    ElseIf TypeOf pSymbol Is ITextSymbol Then
        Dim pTS As ITextSymbol
        Set pTS = pSymbol
        pRGB.RGB = pTS.Color.RGB
    Else
        ' Default = dark grey
        Set pRGB = BuildRGB(40, 40, 40)
    End If
    Set GetRGBFromSymbol = pRGB
    Exit Function
    Resume
eh:
    Set pRGB = BuildRGB(40, 40, 40) ' Dark grey
End Function