Adding new TextStyleRecord/MLeaderStyle

[Rob.O]

I have a some working code that checks for the existence of a text style, and creates it if it does not exist.  It then checks for the existence of an mleader style and creates it if it does not exist.  It then adds a new mleader object.  This new mleader style uses the new text style.

The code works great, but there is one thing I do not understand.  If the text style that the mleader style uses already exists, then new mleaders are created with no problem regardless of what the current text style is set to.  But, if the text style does not exist, I had to make the new text style current in order for the new mleaders I added to the drawing show with the proper text style (even though  the new mleader style is set correctly to the new text style).

Am I doing somthing wrong?

<SNIP>

Dim mlstyleid As ObjectId
                Dim m As MLeader = New MLeader()
                m.LeaderLineType = LeaderType.StraightLeader
                'Set mleader points from user picks
                m.AddLeaderLine(arrowPoint)
                m.AddLastVertex(0, symbolPoint)

                Dim mlname As String = strMlStyle

                Dim dict As DBDictionary = CType(acTrans.GetObject(acDb.MLeaderStyleDictionaryId, OpenMode.ForRead), DBDictionary)

                If Not dict.Contains(strMlStyle) Then

                    Dim newMleadStyle As New MLeaderStyle()

                    newMleadStyle.PostMLeaderStyleToDb(acDb, mlname)
                    newMleadStyle.Annotative = AnnotativeStates.[True]
                    newMleadStyle.DrawMLeaderOrderType = DrawMLeaderOrderType.DrawLeaderFirst
                    newMleadStyle.LeaderLineColor = Autodesk.AutoCAD.Colors.Color.FromColorIndex(Autodesk.AutoCAD.Colors.ColorMethod.ByLayer, 256)
                    newMleadStyle.TextAlignAlwaysLeft = True
                    newMleadStyle.LeaderLineType = LeaderType.StraightLeader
                    newMleadStyle.ContentType = ContentType.MTextContent
                    newMleadStyle.ArrowSize = 0.09375
                    newMleadStyle.BreakSize = 0.0625
                    newMleadStyle.DoglegLength = 0.125
                    newMleadStyle.EnableLanding = True
                    newMleadStyle.EnableDogleg = True
                    newMleadStyle.EnableFrameText = False
                    newMleadStyle.LandingGap = 0.0625
                    newMleadStyle.MaxLeaderSegmentsPoints = 2

                    ' Get the objectID of the ECDT text style
                    Dim textStyleTbl As TextStyleTable = acDb.TextStyleTableId.GetObject(OpenMode.ForRead)
                    Dim TxtRcd As TextStyleTableRecord
                    Dim newTxtRcd As New TextStyleTableRecord

                    If textStyleTbl.Has("ECDT") Then
                        TxtRcd = textStyleTbl("ECDT").GetObject(OpenMode.ForRead)
                    Else
                        ' If text style does not exist, create it
                        newTxtRcd.Name = "ECDT"
                        textStyleTbl.UpgradeOpen()
                        textStyleTbl.Add(newTxtRcd)
                        Dim acNewFont As Autodesk.AutoCAD.GraphicsInterface.FontDescriptor
                        acNewFont = New Autodesk.AutoCAD.GraphicsInterface.FontDescriptor("Century Gothic", False, False, 0, 0)
                        newTxtRcd.Font = acNewFont
                        acTrans.AddNewlyCreatedDBObject(newTxtRcd, True)
                        TxtRcd = textStyleTbl("ECDT").GetObject(OpenMode.ForRead)
                    End If

                    acDb.Textstyle = TxtRcd.ObjectId

                    newMleadStyle.TextStyleId = TxtRcd.ObjectId

<SNIP>

TIA

[Hallex]

I would use separate functions and subs instead of creating long spaghetti code

And also you could be use Try..Catch to find the bad code block easily

Here is a quick example, not so elegant though

Tested on A2009 (eng) only

        Public Shared Sub MainCallingSub()
            Try
                Dim txtid As ObjectId = GetOrCreateTextStyle("MyTextStyle", "Century Gothic", "", 2.0)

                Dim mldid As ObjectId = GetOrCreateMleaderStyle("MyMleaderStyle", txtid)

                Dim cmldStyle As Object = "MyMleaderStyle"

                Autodesk.AutoCAD.ApplicationServices.Application.SetSystemVariable("CMLEADERSTYLE", cmldStyle)

                DrawMleader(txtid)

            Catch ex As System.Exception

                Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(ex.Message & vbLf & ex.ToString)

            End Try

        End Sub



        Public Shared Sub DrawMleader(ByVal txtId As ObjectId)

            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument

            Dim ed As Editor = doc.Editor

            Dim ucs As CoordinateSystem3d = ed.CurrentUserCoordinateSystem.CoordinateSystem3d

            Dim db As Database = HostApplicationServices.WorkingDatabase

            Dim plan As Plane = New Plane(Point3d.Origin, ucs.Zaxis)


            Using tr As Transaction = db.TransactionManager.StartTransaction()

                Try

                    Dim pts As Point3dCollection = New Point3dCollection()

                    pts.Add(New Point3d(0, 0, 0))

                    pts.Add(New Point3d(10, 10, 0))

                    Dim ml As MLeader = New MLeader()

                    ml.SetDatabaseDefaults()

                    'change some mleader properties if it is needed:
                    ml.LeaderLineType = LeaderType.StraightLeader

                    ml.AddLeaderLine(pts(0))

                    ml.AddLastVertex(0, pts(1))

                    ml.ContentType = ContentType.MTextContent

                    Dim mt As New MText()

                    mt.SetDatabaseDefaults()

                    mt.Contents = "1. Alpha\P2. Bravo\P3. Charlie"

                    'change some text properties if it is needed:

                    mt.TextHeight = 1.0

                    mt.TextStyle = txtId

                    ml.ArrowSize = 0.25

                    ml.MText = mt

                    ml.EnableFrameText = False

                    ml.EnableLanding = True

                    ml.LandingGap = 0.1

                    ml.TextAttachmentType = TextAttachmentType.AttachmentBottomLine

                    ml.TextAngleType = TextAngleType.HorizontalAngle

                    ml.EnableDogleg = True

                    Dim i As Integer = 0

                    ml.SetDoglegLength(i, 0.1)

                    'dog leg direction:

                    If (pts(0).X < pts(1).X) Then

                        ml.SetDogleg(i, New Vector3d(plan, New Vector2d(1, 0)))

                        ml.TextAlignmentType = TextAlignmentType.LeftAlignment

                    Else

                        ml.SetDogleg(i, New Vector3d(plan, New Vector2d(-1, 0)))

                        ml.TextAlignmentType = TextAlignmentType.RightAlignment

                    End If

                    Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForRead), BlockTableRecord)

                    btr.UpgradeOpen()

                    btr.AppendEntity(ml)

                    btr.DowngradeOpen()

                    tr.AddNewlyCreatedDBObject(ml, True)

                    tr.Commit()

                Catch ex As Autodesk.AutoCAD.Runtime.Exception

                    ed.WriteMessage(vbCr & ex.Message & vbCr & ex.ToString)

                Finally
                    If Not tr.IsDisposed Then tr.Dispose()
                End Try

            End Using

        End Sub


        Public Shared Function GetOrCreateMleaderStyle(ByVal strMlStyle As String, ByVal txid As ObjectId) As ObjectId
            Dim acDoc As Document = acApp.DocumentManager.MdiActiveDocument
            Dim ed As Editor = acDoc.Editor
            Dim acDb As Database = HostApplicationServices.WorkingDatabase
            Dim id As ObjectId = ObjectId.Null
            Using doclock As DocumentLock = acDoc.LockDocument
                Using acTrans As Transaction = acDb.TransactionManager.StartTransaction()
                    Try

                        Dim dict As DBDictionary = CType(acTrans.GetObject(acDb.MLeaderStyleDictionaryId, OpenMode.ForRead), DBDictionary)

                        If dict.Contains(strMlStyle) Then

                            id = dict.GetAt(strMlStyle)

                        Else

                            Dim newMleadStyle As New MLeaderStyle()

                            newMleadStyle.TextAlignAlwaysLeft = False
                            newMleadStyle.Annotative = AnnotativeStates.True
                            newMleadStyle.DrawMLeaderOrderType = DrawMLeaderOrderType.DrawLeaderFirst
                            newMleadStyle.TextAttachmentType = TextAttachmentType.AttachmentBottomOfTopLine
                            newMleadStyle.LeaderLineColor = Autodesk.AutoCAD.Colors.Color.FromColorIndex(Autodesk.AutoCAD.Colors.ColorMethod.ByLayer, 256)
                            newMleadStyle.TextAlignAlwaysLeft = True
                            newMleadStyle.LeaderLineType = LeaderType.StraightLeader
                            newMleadStyle.ContentType = ContentType.MTextContent
                            newMleadStyle.ArrowSize = 0.09375
                            newMleadStyle.BreakSize = 0.0625
                            newMleadStyle.DoglegLength = 0.125
                            newMleadStyle.EnableLanding = True
                            newMleadStyle.EnableDogleg = True
                            newMleadStyle.EnableFrameText = False
                            newMleadStyle.LandingGap = 0.0625
                            newMleadStyle.MaxLeaderSegmentsPoints = 2
                            newMleadStyle.TextStyleId = txid

                            newMleadStyle.PostMLeaderStyleToDb(acDb, strMlStyle)

                            newMleadStyle.DowngradeOpen()
                            id = newMleadStyle.ObjectId
                            acTrans.Commit()
                            ed.Regen()
                            ''check again
                            If dict.Contains(strMlStyle) Then
                                ed.WriteMessage(vbCr & "MLeaderSyle was created sucessfully")
                            End If
                        End If

                    Catch ex As Autodesk.AutoCAD.Runtime.Exception
                        ed.WriteMessage(ex.Message)
                        id = ObjectId.Null
                    Finally

                    End Try
                End Using
            End Using
            Return id
        End Function


        Public Shared Function GetNonErasedTableRecordId(ByVal TableId As ObjectId, ByVal Name As String) As ObjectId
            ' as posted by Tony Tanzillo 01 Sept 2006
            Dim id As ObjectId = ObjectId.Null
            Using tr As Transaction = TableId.Database.TransactionManager.StartTransaction()
                Dim table As SymbolTable = DirectCast(tr.GetObject(TableId, OpenMode.ForRead), SymbolTable)
                If table.Has(Name) Then
                    id = table(Name)
                    If Not id.IsErased Then
                        Return id
                    End If
                    For Each recId As ObjectId In table
                        If Not recId.IsErased Then
                            Dim rec As SymbolTableRecord = DirectCast(tr.GetObject(recId, OpenMode.ForRead), SymbolTableRecord)
                            If String.Compare(rec.Name, Name, True) = 0 Then
                                Return recId
                            End If
                        End If
                    Next
                End If
            End Using
            Return id
        End Function

        Public Shared Function GetTextStyle(ByVal stylename As String) As ObjectId
            Dim db As Database = HostApplicationServices.WorkingDatabase
            Return GetNonErasedTableRecordId(db.TextStyleTableId, stylename)
        End Function


        Public Shared Function CreateTextStyle(ByVal stylename As String, ByVal filename As String, ByVal bgfilename As String, ByVal textheight As Double) As ObjectId
            Dim id As ObjectId = ObjectId.Null
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim db As Database = HostApplicationServices.WorkingDatabase
            Dim ed As Editor = doc.Editor

            Dim tr As Transaction = doc.TransactionManager.StartTransaction()

            Using tr
                Try
                    Dim tst As TextStyleTable = DirectCast(tr.GetObject(db.TextStyleTableId, OpenMode.ForRead, False), TextStyleTable)

                    Dim ts As New TextStyleTableRecord()

                    ts.Name = stylename

                    ts.FileName = filename


                    If bgfilename <> String.Empty Then

                        ts.BigFontFileName = bgfilename

                    End If

                    ts.TextSize = textheight

                    ts.XScale = 1.0

                    tst.UpgradeOpen()

                    tst.Add(ts)

                    tr.AddNewlyCreatedDBObject(ts, True)

                    id = ts.ObjectId

                    tr.Commit()
                Catch ex As Autodesk.AutoCAD.Runtime.Exception
                    ed.WriteMessage(vbCr & ex.Message)
                End Try

                Return id
            End Using
        End Function


        Public Shared Function GetOrCreateTextStyle(ByVal stylename As String, ByVal fontfilename As String, ByVal bgfilename As String, ByVal textheight As Double) As ObjectId
            Dim id As ObjectId = ObjectId.Null

            id = GetTextStyle(stylename)

            If id = ObjectId.Null Then

                id = CreateTextStyle(stylename, fontfilename, bgfilename, textheight)
            End If

            Return id

        End Function

~'J'~