Message 1 of 4
Adding text in a drawing
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi, I have been working on adding text automatically in a .dwg file, but on some occasions the text is not seen because it is placed on the lines of the drawing and visually is lost, here my question is it possible to place the text on a white background using code?
This is the way I am adding the text in the drawing.
Sub Main()
Dim oDoc As DrawingDocument = ThisApplication.ActiveDocument
Dim oActiveSheet As Sheet = oDoc.ActiveSheet
For Each oDrawingView As DrawingView In oActiveSheet.DrawingViews
If oDrawingView.Name = "VIEW3" Then
Dim oRefDoc As AssemblyDocument = oDrawingView.ReferencedDocumentDescriptor.ReferencedDocument
Dim oAssDef As AssemblyComponentDefinition = oRefDoc.ComponentDefinition
Dim oOcc As ComponentOccurrence
For Each oOcc In oAssDef.Occurrences
Dim oSubOcc As ComponentOccurrence
For Each oSubOcc In oOcc.SubOccurrences
If oSubOcc.Name.Contains("Viewports") Then
Dim activeDoc As DrawingDocument = ThisApplication.ActiveDocument
Dim activeView As DrawingView = activeDoc.ActiveSheet.DrawingViews.Item(3)
Dim occWorkPoint As WorkPoint = GetWorkPointByName(oSubOcc, "WP_1")
Dim centerX As Double = activeView.Position.X - 0.56
Dim centerY As Double = activeView.Position.Y - 2
Dim centerX1 As Double = activeView.Position.X - 0.95
If Not occWorkPoint Is Nothing Then
Dim occWorkPointProxyObj As Object
oSubOcc.CreateGeometryProxy(occWorkPoint, occWorkPointProxyObj)
Dim occWorkPointProxy = TryCast(occWorkPointProxyObj, WorkPointProxy)
Dim xCoordUPP As Double = Math.Abs(occWorkPointProxy.Point.X) / 39.37
Dim yCoordUPP As Double = Math.Abs(occWorkPointProxy.Point.Z) / 39.37
xCoordUPP = Math.Round(xCoordUPP, 2)
yCoordUPP = Math.Round(yCoordUPP, 2)
Dim notePosition As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(centerX1, centerY)
Dim noteText As String = "ID: " & iProperties.Value(oRefDoc.DisplayName, "Custom", "ID")
Dim oGeneralNote As GeneralNote
oGeneralNote = oActiveSheet.DrawingNotes.GeneralNotes.AddFitted(notePosition, noteText)
Dim notePosition1 As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(centerX, yCoordUPP)
Dim noteText1 As String = iProperties.Value(oRefDoc.DisplayName, "Custom", "NumViewport")
Dim oGeneralNote1 As GeneralNote
oGeneralNote1 = oActiveSheet.DrawingNotes.GeneralNotes.AddFitted(notePosition1, noteText1)
End If
End If
Next
Next
End if
Next
End Sub
Function GetWorkPointByName(occ As ComponentOccurrence, workPointName As String) As WorkPoint
Dim occWorkPoints As WorkPoints = GetWorkPoints(occ)
If occWorkPoints IsNot Nothing Then
For Each occWorkPoint As WorkPoint In occWorkPoints
If occWorkPoint.Name = workPointName Then
Return occWorkPoint
End If
Next
End If
Return Nothing
End Function
Function GetWorkPoints(occ As ComponentOccurrence) As WorkPoints
Try
Dim asmDef As AssemblyComponentDefinition = TryCast(occ.Definition, AssemblyComponentDefinition)
If Not asmDef Is Nothing Then Return asmDef.WorkPoints
Return Nothing
Catch
End Try
End Function