Mass Label Contours

Have you ever wanted to label a surface at one time without having to draw multiple lines? Now you can with the simple routine below. The main things that I learned in doing it is the polar point. The polar point allows you to find a point based on a starting point, angle and distance. For this code I find the midpoint between the first and second coordinate point of the contour and then use the polarpoint to find a point a set distance away from the contour that is going to be labeled.

The rest of the code gets some prompts from the user and then extracts the contours from the surface (either major or minor) and the process them, adding the contour labels at interval, starting from the first segment.

The entire dvb file may be found here: http://style.civil3dreminders.com/masscontourlabels

'
' MODULE_ID {Subroutines.bas}
' {LabelContours.dvb}
'
' Copyright {2008} by Autodesk, Inc.
'
' Permission to use, copy, modify, and distribute this software for
' any purpose and without fee is hereby granted, provided that the
' above copyright notice appears in all copies and  that both that
' copyright notice and the limited warranty and  restricted rights
' notice below appear in all supporting  documentation.
'
' AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
' AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
' MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
' DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
' UNINTERRUPTED OR ERROR FREE.
'
' Use, duplication, or disclosure by the U.S. Government is subject to
' restrictions set forth in FAR 52.227-19 (Commercial Computer
' Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
' (Rights in Technical Data and Computer Software), as applicable.
'
'
'
Option Explicit



'
' These are all the subroutines that can be called from
' Civil 3D's VBRUN command.
'


'
' Label major contours
'
'
Sub LabelMultipleContours()
    'always get the objects again since MDI is supported
    If (GetCivilObjects = False) Then
        Exit Sub
    End If
   
    Dim oSurface As AeccTinSurface
   
    Dim vPoint As Variant
   
    ThisDrawing.Utility.GetEntity oSurface, vPoint, "Select Surface: "
   
    Dim strInput As String
   
    With ThisDrawing.Utility
        .InitializeUserInput 0, "Minor mAjor"
        strInput = ThisDrawing.Utility.GetKeyword("Enter contour type to label [Minor/mAjor]: ")
    End With
   
    Dim dInterval As Double
   
    On Error Resume Next
    With ThisDrawing.Utility
        .InitializeUserInput 6
        dInterval = ThisDrawing.Utility.GetReal("Interval along contour <500>: ")
        ' If user enters then utilize the default value.
        If Err Then
            If Err.Number = -2145320928 Then
                Err.Clear
                dInterval = 500
            Else
                ThisDrawing.Utility.Prompt Err.Number
                Exit Sub
            End If
        End If
    End With
   
    Dim vContours As Variant
   
    Select Case strInput
        Case "Minor"
            vContours = oSurface.ExtractContour(aeccDisplayOrientationPlan, aeccSFMinorContours, oSurface.Statistics.MinElevation, oSurface.Statistics.MaxElevation)
        Case "mAjor"
            vContours = oSurface.ExtractContour(aeccDisplayOrientationPlan, aeccSFMajorContours, oSurface.Statistics.MinElevation, oSurface.Statistics.MaxElevation)
    End Select
   
   
    Dim i As Integer
    Dim oPoly As AcadLWPolyline
    Dim dX1 As Double
    Dim dY1 As Double
    Dim dX2 As Double
    Dim dY2 As Double
    Dim dMidX As Double
    Dim dMidY As Double
    Dim dM As Double
    Dim dMPerp As Double
    Dim dBasePoint(0 To 2) As Double
    Dim dAngle As Double
    Dim dAngle2 As Double
    Dim vPolarPt As Variant
    Dim vPolarPt2 As Variant
   
    For i = 0 To UBound(vContours)
        Set oPoly = vContours(i)
        dX1 = oPoly.Coordinates(0)
        dY1 = oPoly.Coordinates(1)
        dX2 = oPoly.Coordinates(2)
        dY2 = oPoly.Coordinates(3)
       
        dMidX = (dX1 + dX2) / 2
        dMidY = (dY1 + dY2) / 2
        dBasePoint(0) = dMidX: dBasePoint(1) = dMidY
       
        dAngle = ThisDrawing.Utility.AngleFromXAxis(oPoly.Coordinate(0), oPoly.Coordinate(1)) + (4 * Atn(1)) / 2 ' Added 90 degrees to the value
       
        vPolarPt = ThisDrawing.Utility.PolarPoint(dBasePoint, dAngle, 0.01)
        vPolarPt2 = ThisDrawing.Utility.PolarPoint(dBasePoint, dAngle, -0.1)

        ThisDrawing.SendCommand "_AeccAddContourLabelingGroup " & vPolarPt(0) & "," & vPolarPt(1) & " " & vPolarPt2(0) & "," & vPolarPt2(1) & " " & dInterval & " "
        oPoly.Delete
    Next
   
End Sub

adf