Create Multiple Profiles

Do you have the need to create multiple existing ground surface profiles in a drawing? Way back I did a post accomplishing the task in Civil 3D 2008 using VBA. Here’s an update utilizing .NET and Civil 3D 2010.

' (C) Copyright 2010 by Christopher Fugitt
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime
Imports AutoCAD = Autodesk.AutoCAD.Interop
Imports AeccLandLib = Autodesk.AECC.Interop.Land
Imports AeccLandUi = Autodesk.AECC.Interop.UiLand
Imports AecUIBase = Autodesk.AEC.Interop.UIBase
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Interop.Common
Imports Autodesk.Civil.ApplicationServices
Imports Autodesk.Civil.Land
Imports C3DRemindersPack.Utilities
Imports Quux.C3DUtilities

<Assembly: CommandClass(GetType(CreateEGProfiles))> 

Public Class CreateEGProfiles

<CommandMethod("C3DRCreateEGProfiles")> _
Public Sub EGCreate()

Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
Dim tm As Autodesk.AutoCAD.DatabaseServices.TransactionManager = db.TransactionManager
Dim trans As Autodesk.AutoCAD.DatabaseServices.Transaction = tm.StartTransaction()

Try
Dim oCivil As New AeccAppConnection
Dim oC3DR As New Utilities

Dim oType(0) As Type
oType(0) = GetType(Autodesk.Civil.Land.DatabaseServices.Surface)

Dim oSurfObjId As ObjectId = oC3DR.GetEntityWithOptions("Select Surface: ", "Surface not selected.)", oType)

Dim obj As AeccLandLib.AeccSurface = oCivil.AeccDoc.ObjectIdToObject(CType(oSurfObjId.OldIdPtr, Integer))

Dim oAlign As AeccLandLib.AeccAlignment

' Get a style from the collection.
            Dim oStyle As AeccLandLib.AeccProfileStyle = oCivil.AeccDoc.LandProfileStyles.Item(0)

For Each oAlign In oCivil.AeccDoc.AlignmentsSiteless
Try
'Check to see if the profile exists, if it does it doesn't need to be recreated.
                    Dim oProfile As AeccLandLib.AeccProfile = oAlign.Profiles.Item("ExistingGround")
Catch
' The profile doesn't exist, so create it.
                    oAlign.Profiles.AddFromSurface("ExistingGround", Autodesk.AECC.Interop.Land.AeccProfileType.aeccExistingGround, _
oStyle.Name, obj.Name, oAlign.StartingStation, oAlign.EndingStation, "0")
End Try
Next

Dim oSite As AeccLandLib.AeccSite
For Each oSite In oCivil.AeccDoc.Sites
For Each oAlign In oSite.Alignments
Try
'Check to see if the profile exists, if it does it doesn't need to be recreated.
                        Dim oProfile As AeccLandLib.AeccProfile = oAlign.Profiles.Item("ExistingGround")
Catch
' The profile doesn't exist, so create it.
                        oAlign.Profiles.AddFromSurface("ExistingGround", Autodesk.AECC.Interop.Land.AeccProfileType.aeccExistingGround, _
oStyle.Name, obj.Name, oAlign.StartingStation, oAlign.EndingStation, "0")
End Try
Next
Next

trans.Commit()

Catch ex As Autodesk.AutoCAD.Runtime.Exception

trans.Abort()

Finally

trans.Dispose() ' Done with transaction

End Try

End Sub


End Class