Group Breaklines with Mid-Ordinate Distance One and Greater

This code was intended to search through a TIN surface’s breaklines and add the ones with a mid ordinate distance of 1 or greater into a group. It works except when the breakline names are duplicated. In that case only one set of breaklines are shown. It appears to be a bug in the API.

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports ACADdb = Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.Civil.DatabaseServices
Imports Autodesk.AECC.Interop.Land
Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common
Imports Autodesk.AutoCAD.DatabaseServices
Imports Quux.C3DUtilities

<Assembly: CommandClass(GetType(LabelNote))> 

Public Class LabelNote

    <CommandMethod("C3DRGroupBreaklinesByMidOrdDistance")> _
    Public Sub ColorBreaklines()
        Try

            'Get Civil 3D application, document and database
            Dim oCivil As New AeccAppConnection

            ' Have the user select a general note label.
            Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
            Dim entopts As New PromptEntityOptions("Select a TIN Surface: ")
            entopts.SetRejectMessage("You did not select a valid entity")

            Dim entRes As PromptEntityResult = ed.GetEntity(entopts)

            If entRes.Status = PromptStatus.OK Then
                Dim entid As ObjectId = entRes.ObjectId
                Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
                Dim tm As Autodesk.AutoCAD.DatabaseServices.TransactionManager = db.TransactionManager
                Using myT As Transaction = tm.StartTransaction()
                    Dim oSurfaceEnt As ACADdb.Entity = DirectCast(tm.GetObject(entid, OpenMode.ForWrite, True), ACADdb.Entity)
                    Dim oSurface As AeccTinSurface = oCivil.AeccDoc.ObjectIdToObject(CType(oSurfaceEnt.ObjectId.OldIdPtr, Long))
                    Dim oBreaklines As AeccSurfaceBreaklines = oSurface.Breaklines
                    Dim oBreakline As AeccSurfaceBreakline
                    Dim objColl As New ObjectIdCollection

                    For Each oBreakline In oBreaklines
                        If oBreakline.MidOrdinateDistance >= 1 Then
                            Dim vEntities() As Object
                            vEntities = oBreakline.BreaklineEntities
                            Dim oEntity As AcadEntity
                            For Each oEntity In vEntities
                                objColl.Add(ACADdb.DBObject.FromAcadObject(oEntity))
                            Next
                        End If
                    Next
                    CreateGroup("C3DRBreaklinesToReadd", objColl)
                    myT.Commit()
                End Using
            End If
        Catch ex As Exception
            Dim oC3DR As New C3DRemindersPack.Utilities
            oC3DR.MessageWriter("Error changing note label: " & ex.Message)
        End Try
    End Sub

    Private Function CreateGroup(ByVal sName As String, ByVal ObjIds As ObjectIdCollection) As Boolean
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor
        Dim tr As Transaction = db.TransactionManager.StartTransaction()
        Using tr
            Dim gd As DBDictionary = DirectCast(tr.GetObject(db.GroupDictionaryId, OpenMode.ForRead), DBDictionary)

            Try
                ' Validate the provided symbol table name
                SymbolUtilityServices.ValidateSymbolName(sName, False)

                ' Only set the block name if it isn't in use
                If gd.Contains(sName) Then
                    ' A group with this name already exists, erase it.
                    ' Dim oGroup As Group = DirectCast(tr.GetObject(gd.Item(sName).ObjectId, OpenMode.ForWrite), Group)
                    EraseGroup(gd.GetAt(sName))
                End If
                Dim oGroup As New Group(sName, True)
                ' Add the new group to the dictionary
                gd.UpgradeOpen()
                Dim oGroupId As ObjectId = gd.SetAt(sName, oGroup)
                tr.AddNewlyCreatedDBObject(oGroup, True)

                oGroup.InsertAt(0, ObjIds)
                tr.Commit()
            Catch
                ed.WriteMessage(vbLf & "Invalid group name.")
            End Try

        End Using


    End Function

    Private Function EraseGroup(ByVal objId As ObjectId) As Boolean
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor
        Dim tr As Transaction = db.TransactionManager.StartTransaction()
        Using tr
            Try
                Dim oGroup As Group = DirectCast(tr.GetObject(objId, OpenMode.ForWrite), Group)
                oGroup.Erase()
                tr.Commit()
            Catch ex As Exception
                Dim oC3DRUtil As New Utilities
                oC3DRUtil.MessageWriter("Error erasing Group: " & ex.Message)

            End Try

        End Using


    End Function

End Class

It doesn’t appear to work in Civil 3D 2010 or 2011.