Monday, February 01, 2010

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
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
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:

1 comment:

mark said...

wow.pretty slick.


Blog Widget by LinkWithin