`

Convert multiple lwpolylines into multiple alignments (VB.NET)

How to convert multiple lwpolylines into multiple alignments was a question in the Autodesk Civil 3D Customization forum. This is a redo from privious post just in VB.NET.

The concept is the same: The first part is just to create the selection with polylines only. The main part is encapsuled in a transaction. Inside this transaction it is ensured that a valid layer, an alignment style and an alignment label style exist, options are setted and than each polyline of the selection is converted to an alignment with a unique name.

' (C) Copyright 2011 by  
' Andreas (Lu An Jie)

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput

Imports Autodesk.Civil.ApplicationServices
Imports Autodesk.Civil.DatabaseServices
Imports Autodesk.Civil.Settings


' This line is not mandatory, but improves loading performances
<Assembly: CommandClass(GetType(ALC_VB_AlignmentFromPolyline.MyCommands))>
Namespace ALC_VB_AlignmentFromPolyline

    Public Class MyCommands


        ' Modal Command with pickfirst selection
        <CommandMethod("MyAlignmentFromPolyline", CommandFlags.Modal)>
        Public Sub MyPickFirst()
            'Get the current document And database
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor
            Dim civdoc As CivilDocument = CivilApplication.ActiveDocument

            'Build a filter list so that only olyline are selected
            Dim arTV(0) As TypedValue
            arTV.SetValue(New TypedValue(DxfCode.Start, "LWPOLYLINE"), 0)

            Dim filter As SelectionFilter = New SelectionFilter(arTV)
            Dim pso As PromptSelectionOptions = New PromptSelectionOptions()
            pso.MessageForAdding = "Select polylines"

            'Get a selection
            Dim result As PromptSelectionResult = ed.GetSelection(pso, filter)
            If (result.Status = PromptStatus.OK And Not IsDBNull(result.Value)) Then

                ed.WriteMessage(vbCrLf + "Valid selection")

                Dim tr As Transaction = db.TransactionManager.StartTransaction()
                Try

                    'get id of Layer
                    Dim idLayer As ObjectId = db.Clayer
                    Dim lt As LayerTable = tr.GetObject(db.LayerTableId, OpenMode.ForRead)
                    If (lt.Has("alignments")) Then idLayer = lt("alignments")

                    'get objectid  of the 1st Alignment style Or Basic
                    Dim idStyle As ObjectId = civdoc.Styles.AlignmentStyles(0)
                    If (civdoc.Styles.AlignmentStyles.Contains("Basic")) Then idStyle = civdoc.Styles.AlignmentStyles("Basic")

                    'get objectid of the 1st AlignmentLabelSetStyle Or Basic
                    Dim idLabelSet As ObjectId = civdoc.Styles.LabelSetStyles.AlignmentLabelSetStyles(0)
                    If (civdoc.Styles.LabelSetStyles.AlignmentLabelSetStyles.Contains("Basic")) Then idLabelSet = civdoc.Styles.LabelSetStyles.AlignmentLabelSetStyles("Basic")




                    'step through the objects in the selection set
                    Dim ss As SelectionSet = result.Value
                    For Each sob As SelectedObject In ss
                        'check is object Is from the expected type
                        If (sob.ObjectId.ObjectClass.DxfName = "LWPOLYLINE") Then

                            ' set options
                            Dim plos As PolylineOptions = New PolylineOptions()
                            plos.AddCurvesBetweenTangents = True
                            plos.EraseExistingEntities = True
                            plos.PlineId = sob.ObjectId

                            'create unique name
                            Dim sccae As SettingsCmdCreateAlignmentEntities = civdoc.Settings.GetSettings(Of SettingsCmdCreateAlignmentEntities)()
                            Dim nAlign As String = Alignment.GetNextUniqueName(sccae.DefaultNameFormat.AlignmentNameTemplate.Value)
                            ed.WriteMessage(vbCrLf + nAlign)
                            'create alignment
                            Dim idAlign As ObjectId = Alignment.Create(civdoc, plos, nAlign, ObjectId.Null, idLayer, idStyle, idLabelSet)
                        End If
                    Next

                    tr.Commit()

                Catch ex As Autodesk.AutoCAD.Runtime.Exception
                    ' ok so we have an exception
                    ed.WriteMessage("problem due to " + ex.Message)
                Finally
                    ' all done, whether an error on not - dispose the transaction.
                    tr.Dispose()
                End Try
            Else
                ed.WriteMessage("No Polylines selected")
            End If
        End Sub


    End Class

End Namespace