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