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
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'~