Set Points of Alignment on ROW

Some people have the need to set points on the ROW based on the geometry of an alignment and elevation of a profile. This post will show one method of creating an easy button to accomplish the task.

The first thing that needs to be added is some overhead items.

Option Explicit

Public g_oCivilApp As AeccApplication
Public g_oDocument As AeccDocument
Public g_oDatabase As AeccDatabase


'
' Start Civil 3D and create Civil 3D document and database objects.
'
Function GetGlobalCivilObjects() As Boolean
    Dim oAcadApp As AcadApplication
    Set oAcadApp = ThisDrawing.Application
    ' NOTE - Always specify the version number.
    Const sAppName = "AeccXUiLand.AeccApplication.7.0"
    Set g_oCivilApp = oAcadApp.GetInterfaceObject(sAppName)
    If (g_oCivilApp Is Nothing) Then
        MsgBox "Error creating " & sAppName & ", exit."
        GetGlobalCivilObjects = False
        Exit Function
    End If
    Set g_oDocument = g_oCivilApp.ActiveDocument
    Set g_oDatabase = g_oDocument.Database

    ' Mark that this function was already called.  No need
    ' do perform this action again once we already have the
    ' objects.
    GetGlobalCivilObjects = True
End Function

Next some code needs to be added that gets information from the user, such as the alignment, offsets and profile. Also in there is the generic On Error Resume Next, but better error catching could be utilized.

Sub SetPoints()
    
    On Error Resume Next
    
    ' Always get the objects again since MDI is supported.
    If (GetGlobalCivilObjects() = False) Then
        MsgBox "Error accessing root objects."
        Exit Sub
    End If
    
    Dim oAcadObj As AcadObject
    Dim vPickPt As Variant
    ThisDrawing.Utility.GetEntity oAcadObj, vPickPt, "Select alignment: "
    
    ' Prompt the user for the alignment.
    Dim oAlign As AeccAlignment
    If (TypeOf oAcadObj Is AeccAlignment) Then
        Set oAlign = oAcadObj
    Else
        ThisDrawing.Utility.Prompt "That wasn't an alignment"
        Exit Sub
    End If
    
    ' Prompt the user for the Offset Right & Left.
    Dim dOffRight, dOffLeft As Double
    dOffRight = ThisDrawing.Utility.GetReal("Right Offset: ")
    dOffLeft = ThisDrawing.Utility.GetReal("Left Offset: ")
    
    ' Prompt the user for the profile.
    Dim oProfile As AeccProfile
    ThisDrawing.Utility.GetEntity oAcadObj, vPickPt, "Select profile: "
    If (TypeOf oAcadObj Is AeccProfile) Then
        Set oProfile = oAcadObj
    Else
        ThisDrawing.Utility.Prompt "That wasn't a profile"
        Exit Sub
    End If

Now that all of the information we need have been collected we can utilize it to accomplish our end goals. The first thing we need to get is the collection of stations. With this we can go through each station value and get the results. We can get different types of stations, in this case I’m getting the aeccGeometryPoint stations. This will get the collection of geometry points of the alignment.

    Dim oStation As AeccAlignmentStation
    Dim oPoint As AeccPoint
    Dim dX As Double
    Dim dY As Double
    Dim dZ As Double
    For Each oStation In oAlign.GetStations(aeccGeometryPoint, 100#, 0#)

Next we need to get the geometry type in a string form to add to the description. To do this I’ll use a Function called GetGeomType (located at the end of this post).

        Dim dLoc(0 To 2) As Double
        Dim sGeomType As String
        sGeomType = GetGeomType(oStation.GeometryPointType)

Now I’ll get the point information for the right side and use that information to create a point and give it an appropriate description.

        ' Set the right side
        oAlign.PointLocation oStation.Station, dOffRight, dX, dY
        dZ = oProfile.ElevationAt(oStation.Station)
        dLoc(0) = dX: dLoc(1) = dY: dLoc(2) = dZ
        Set oPoint = g_oDocument.Points.Add(dLoc)
        oPoint.Description = sGeomType & " " & Format(oStation.Station, "0+##.00") & " " & Format(dOffRight, "#.00")

And lastly I’ll do the same for the opposite side.

        ' Set the left side
        oAlign.PointLocation oStation.Station, -dOffLeft, dX, dY
        dZ = oProfile.ElevationAt(oStation.Station)
        dLoc(0) = dX: dLoc(1) = dY: dLoc(2) = dZ
        Set oPoint = g_oDocument.Points.Add(dLoc)
        oPoint.Description = sGeomType & " " & Format(oStation.Station, "0+##.00") & " " & Format(-dOffLeft, "#.00")

And here’s the function to get the Geometry Type. If I didn’t know what the value should be I added “???”. You can change the value to the string that you want to use. For this function I’m pulling the abbreviations from the drawing settings.

Function GetGeomType(oType As AeccGeometryPointType) As String
    Dim oAlignAbbrev As AeccSettingsAbbreviationAlignment
    Set oAlignAbbrev = g_oDocument.Settings.DrawingSettings.AbbreviationSettings.AlignmentAbbreviations
    
    Select Case oType
        Case aeccBegOfAlign
            GetGeomType = oAlignAbbrev.AlignmentBeginning
        Case aeccEndOfAlign
            GetGeomType = oAlignAbbrev.AlignmentEnd
        Case aeccTanTan
            GetGeomType = oAlignAbbrev.TangentTangentIntersect
        Case aeccTanCurve
            GetGeomType = oAlignAbbrev.TangentCurveIntersect
        Case aeccCurveTan
            GetGeomType = oAlignAbbrev.CurveTangentIntersect
        Case aeccCurveCompCurve
            GetGeomType = oAlignAbbrev.CompoundCurveCurveIntersect
        Case aeccCurveRevCurve
            GetGeomType = oAlignAbbrev.ReverseCurveCurveIntersect
        Case aeccLineSpiral
            GetGeomType = oAlignAbbrev.TangentSpiralIntersect
        Case aeccSpiralLine
            GetGeomType = oAlignAbbrev.SpiralTangentIntersect
        Case aeccCurveSpiral
            GetGeomType = oAlignAbbrev.CurveSpiralIntersect
        Case aeccSpiralCurve
            GetGeomType = oAlignAbbrev.SpiralCurveIntersect
        Case aeccSpiralCompSpiral
            GetGeomType = oAlignAbbrev.SpiralCurveIntersect
        Case aeccSpiralRevSpiral
            GetGeomType = oAlignAbbrev.ReverseSpiralIntersect
        Case aeccPI
            GetGeomType = oAlignAbbrev.TangentTangentIntersect
        Case aeccCPI
            GetGeomType = "???"
        Case aeccSPI
            GetGeomType = "???"
        Case aeccBeginNormalCrown
            GetGeomType = "???"
        Case aeccBeginNormalShoulder
            GetGeomType = "???"
        Case aeccBeginFullSuper
            GetGeomType = "???"
        Case aeccEndFullSuper
            GetGeomType = "???"
        Case aeccEndNormalShoulder
            GetGeomType = "???"
        Case aeccEndNormalCrown
            GetGeomType = "???"
        Case aeccLevelCrown
            GetGeomType = "???"
        Case aeccLowShoulderMatch
            GetGeomType = "???"
        Case aeccReverseCrown
            GetGeomType = "???"
        Case aeccManual
            GetGeomType = "???"
        Case aeccShoulderBreakOver
            GetGeomType = "???"
        Case aeccInvalidSuper
            GetGeomType = "???"
        Case Else
            GetGeomType = "???"
    End Select

End Function

Lastly here’s the program in action:

If you want to download the program you can find it here: http://style.civil3dreminders.com/SetPointsOfAlignmentOnROW.dvb