Altojoe
New member
- Mar 16, 2013
- 23
Hi,
I have created a journal to update some of the fonts in Dwg, In the below code I am unable to get update from Table fonts and also I need some inputs for the lettering size factor in view label style...I want to control it through VBA...
Thanks in Advance....
![[pc] [pc] [pc]](/data/assets/smilies/pc.gif)
Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports System.Windows.Forms
Imports NXOpen.Annotations
Imports NXOpen.Utilities
' NX Font Update
' Journal created by Alto on 20-05-2015
Module NXJournal
Dim ufs As UFSession = UFSession.GetUFSession()
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Sub Main()
'Update Note Dimension
For Each note1 As Annotations.Note In workPart.Notes
Dim lineAndArrowPreferences1 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences1 = note1.GetLineAndArrowPreferences()
Dim letteringPreferences1 As Annotations.LetteringPreferences
letteringPreferences1 = note1.GetLetteringPreferences()
Dim fontIndex1 As Integer
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")
' Font is associated with integer 4
Dim generalText1 As Annotations.Lettering
generalText1.Size = 0.1
generalText1.CharacterSpaceFactor = 1.0
generalText1.AspectRatio = 1.0
generalText1.LineSpaceFactor = 1.0
generalText1.Cfw.Color = 6
generalText1.Cfw.Font = 51
generalText1.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences1.SetGeneralText(generalText1)
note1.SetLetteringPreferences(letteringPreferences1)
note1.RedisplayObject()
Next
'Update Special Notes of BE
For Each note2 As Annotations.Note In workPart.Notes
Dim Text1(0) As String
Text1 = note2.GetText
If Text1(0) = "<W@DB_PART_MARK>" Then
Dim lineAndArrowPreferences2 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences2 = note2.GetLineAndArrowPreferences()
Dim letteringPreferences2 As Annotations.LetteringPreferences
letteringPreferences2 = note2.GetLetteringPreferences()
Dim fontIndex1 As Integer
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")
' Font is associated with integer 4
Dim generalText2 As Annotations.Lettering
generalText2.Size = 0.06
generalText2.CharacterSpaceFactor = 1.0
generalText2.AspectRatio = 1.0
generalText2.LineSpaceFactor = 1.0
generalText2.Cfw.Color = 2
generalText2.Cfw.Font = 51
generalText2.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences2.SetGeneralText(generalText2)
note2.SetLetteringPreferences(letteringPreferences2)
note2.RedisplayObject()
ElseIf Text1(0) = "<W@DB_JOB_NUMBER>" Or Text1(0) = "<W@$SH_SHEET_NUMBER> <W@$SH_NUMBER_OF_SHEETS>" Then
Dim lineAndArrowPreferences3 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences3 = note2.GetLineAndArrowPreferences()
Dim letteringPreferences3 As Annotations.LetteringPreferences
letteringPreferences3 = note2.GetLetteringPreferences()
Dim fontIndex1 As Integer
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")
' Font is associated with integer 4
Dim generalText3 As Annotations.Lettering
generalText3.Size = 0.09
generalText3.CharacterSpaceFactor = 1.0
generalText3.AspectRatio = 1.0
generalText3.LineSpaceFactor = 1.0
generalText3.Cfw.Color = 2
generalText3.Cfw.Font = 51
generalText3.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences3.SetGeneralText(generalText3)
note2.SetLetteringPreferences(letteringPreferences3)
note2.RedisplayObject()
ElseIf Text1(0) = "<W@DB_PART_NAME>" Then
Dim lineAndArrowPreferences4 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences4 = note2.GetLineAndArrowPreferences()
Dim letteringPreferences4 As Annotations.LetteringPreferences
letteringPreferences4 = note2.GetLetteringPreferences()
Dim fontIndex1 As Integer
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")
' Font is associated with integer 4
Dim generalText3 As Annotations.Lettering
generalText3.Size = 0.125
generalText3.CharacterSpaceFactor = 1.0
generalText3.AspectRatio = 1.0
generalText3.LineSpaceFactor = 1.0
generalText3.Cfw.Color = 2
generalText3.Cfw.Font = 51
generalText3.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences4.SetGeneralText(generalText3)
note2.SetLetteringPreferences(letteringPreferences4)
note2.RedisplayObject()
End If
Next
'Update Dimension and appended text
Dim Dimension1 As Dimension
For Each Dimension1 In workPart.Dimensions
Dim dimensionPreferences1 As Annotations.DimensionPreferences
dimensionPreferences1 = Dimension1.GetDimensionPreferences()
Dim letteringPreferences5 As Annotations.LetteringPreferences
letteringPreferences5 = Dimension1.GetLetteringPreferences()
Dim fontIndex1 As Integer
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")
' Font is associated with integer 3
Dim dimensionText1 As Annotations.Lettering
dimensionText1.Size = 0.1
dimensionText1.CharacterSpaceFactor = 2.0
dimensionText1.AspectRatio = 1.0
dimensionText1.LineSpaceFactor = 1.0
dimensionText1.Cfw.Color = 6
dimensionText1.Cfw.Font = 51
dimensionText1.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences5.SetDimensionText(dimensionText1)
letteringPreferences5.SetAppendedText(dimensionText1)
letteringPreferences5.SetToleranceText(dimensionText1)
Dimension1.SetLetteringPreferences(letteringPreferences5)
Dim lineAndArrowPreferences1 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences1 = Dimension1.GetLineAndArrowPreferences()
dimensionPreferences1.Dispose()
letteringPreferences5.Dispose()
Dimension1.RedisplayObject()
Next
'Update all Id symbols Line and Arrow preferences not included as User need different Arrowheads
For Each Idsymbol1 As Annotations.IdSymbol In workPart.Annotations.IdSymbols
Dim symbolPreferences1 As Annotations.SymbolPreferences
symbolPreferences1 = Idsymbol1.GetSymbolPreferences()
Dim lineAndArrowPreferences1 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences1 = Idsymbol1.GetLineAndArrowPreferences()
Dim letteringPreferences6 As Annotations.LetteringPreferences
letteringPreferences6 = Idsymbol1.GetLetteringPreferences()
Dim generalText4 As Annotations.Lettering
generalText4.Size = 0.1
generalText4.CharacterSpaceFactor = 1.0
generalText4.AspectRatio = 1.0
generalText4.LineSpaceFactor = 1.0
generalText4.Cfw.Color = 6
generalText4.Cfw.Font = 51
generalText4.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences6.SetGeneralText(generalText4)
Idsymbol1.SetLetteringPreferences(letteringPreferences6)
symbolPreferences1.IdSymbolSize = 0.35
Idsymbol1.SetSymbolPreferences(symbolPreferences1)
letteringPreferences6.Dispose()
lineAndArrowPreferences1.Dispose()
symbolPreferences1.Dispose()
Idsymbol1.RedisplayObject()
Next
'Update Label Font for all the Labels not letter size factor
Dim NULL_TAG As NXOpen.Tag = NXOpen.Tag.Null
Dim obj As NXOpen.Tag = NULL_TAG
Do
obj = ask_next_drf_entity(obj)
If obj = NULL_TAG Then
GoTo end1
End If
' Check whether returned Tag is UF_draft_label_subtype
Dim type As Integer = Nothing
Dim subtype As Integer = Nothing
ufs.Obj.AskTypeAndSubtype(obj, type, subtype)
Dim nxobj As NXObject = NXObjectManager.Get(obj)
If nxobj.GetType().ToString() <> "NXOpen.Annotations.Label" Then
Continue Do
Else
Dim Label1 As Annotations.Label = nxobj
Dim letteringPreferences7 As Annotations.LetteringPreferences
letteringPreferences7 = Label1.GetLetteringPreferences()
Dim generalText5 As Annotations.Lettering
generalText5.Size = 0.1
generalText5.CharacterSpaceFactor = 1.0
generalText5.AspectRatio = 1.0
generalText5.LineSpaceFactor = 1.0
generalText5.Cfw.Color = 6
generalText5.Cfw.Font = 51
generalText5.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences7.SetGeneralText(generalText5)
Label1.SetLetteringPreferences(letteringPreferences7)
letteringPreferences7.Dispose()
Label1.RedisplayObject()
End If
Loop Until obj = NULL_TAG
End1:
Dim NULL_TAG1 As NXOpen.Tag = NXOpen.Tag.Null
Dim obj1 As NXOpen.Tag = NULL_TAG1
Do
obj1 = Ask_Tab_note(obj1)
If obj1 = NULL_TAG1 Then
GoTo end2
End If
' Check whether returned Tag is UF_draft_label_subtype
Dim type As Integer = Nothing
Dim subtype As Integer = Nothing
ufs.Obj.AskTypeAndSubtype(obj1, type, subtype)
Dim nxobj1 As NXObject = NXObjectManager.Get(obj1)
If obj1.GetType().ToString() <> "Tabular Note Cell" Then
Continue Do
Else
Dim Cell1 As Annotations.Note = nxobj1
Dim letteringPreferences8 As Annotations.LetteringPreferences
letteringPreferences8 = Cell1.GetLetteringPreferences()
Dim generalText6 As Annotations.Lettering
generalText6.Size = 0.3
generalText6.CharacterSpaceFactor = 1.0
generalText6.AspectRatio = 1.0
generalText6.LineSpaceFactor = 1.0
generalText6.Cfw.Color = 6
generalText6.Cfw.Font = 51
generalText6.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences8.SetGeneralText(generalText6)
Cell1.SetLetteringPreferences(letteringPreferences8)
letteringPreferences8.Dispose()
'Dim cellPrefs1 As UFTabnot.CellPrefs
'cellPrefs1 = Cell1.getcellPrefs
'cellPrefs1.format = UFTabnot.Format.FormatText
'cellPrefs1.text_font = 51
'cellPrefs1.text_height = 0.06
'cellPrefs1.text_aspect_ratio = 1.0 '
'cellPrefs1.text_angle = 0.0
'cellPrefs1.text_slant = 0.0
'cellPrefs1.line_space_factor = 1.0
'cellPrefs1.char_space_factor = 1.0
'cellPrefs1.text_color = 6
'cellPrefs1.text_density = "Thin"
'cellPrefs1 = Cell1.SetcellPrefs
Cell1.RedisplayObject()
End If
Loop Until obj1 = NULL_TAG1
End2:
End Sub
Public Function Ask_Tab_note(ByRef obj1 As NXOpen.Tag) As NXOpen.Tag
Dim part As NXOpen.Tag = workPart.Tag
ufs.Obj.CycleObjsInPart(part, UFConstants.UF_tabular_note_cell_subtype, obj1)
Return obj1
End Function
Public Function GetUnloadOption(ByVal dummy As String) As Integer
'Unloads the image immediately after execution within NX
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
End Function
Public Function ask_next_drf_entity(ByRef obj As NXOpen.Tag) As NXOpen.Tag
Dim part As NXOpen.Tag = Workpart.Tag
ufs.Obj.CycleObjsInPart(part, UFConstants.UF_drafting_entity_type, obj)
Return obj
End Function
End Module
I have created a journal to update some of the fonts in Dwg, In the below code I am unable to get update from Table fonts and also I need some inputs for the lettering size factor in view label style...I want to control it through VBA...
Thanks in Advance....
![[pc] [pc] [pc]](/data/assets/smilies/pc.gif)
Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports System.Windows.Forms
Imports NXOpen.Annotations
Imports NXOpen.Utilities
' NX Font Update
' Journal created by Alto on 20-05-2015
Module NXJournal
Dim ufs As UFSession = UFSession.GetUFSession()
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Sub Main()
'Update Note Dimension
For Each note1 As Annotations.Note In workPart.Notes
Dim lineAndArrowPreferences1 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences1 = note1.GetLineAndArrowPreferences()
Dim letteringPreferences1 As Annotations.LetteringPreferences
letteringPreferences1 = note1.GetLetteringPreferences()
Dim fontIndex1 As Integer
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")
' Font is associated with integer 4
Dim generalText1 As Annotations.Lettering
generalText1.Size = 0.1
generalText1.CharacterSpaceFactor = 1.0
generalText1.AspectRatio = 1.0
generalText1.LineSpaceFactor = 1.0
generalText1.Cfw.Color = 6
generalText1.Cfw.Font = 51
generalText1.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences1.SetGeneralText(generalText1)
note1.SetLetteringPreferences(letteringPreferences1)
note1.RedisplayObject()
Next
'Update Special Notes of BE
For Each note2 As Annotations.Note In workPart.Notes
Dim Text1(0) As String
Text1 = note2.GetText
If Text1(0) = "<W@DB_PART_MARK>" Then
Dim lineAndArrowPreferences2 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences2 = note2.GetLineAndArrowPreferences()
Dim letteringPreferences2 As Annotations.LetteringPreferences
letteringPreferences2 = note2.GetLetteringPreferences()
Dim fontIndex1 As Integer
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")
' Font is associated with integer 4
Dim generalText2 As Annotations.Lettering
generalText2.Size = 0.06
generalText2.CharacterSpaceFactor = 1.0
generalText2.AspectRatio = 1.0
generalText2.LineSpaceFactor = 1.0
generalText2.Cfw.Color = 2
generalText2.Cfw.Font = 51
generalText2.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences2.SetGeneralText(generalText2)
note2.SetLetteringPreferences(letteringPreferences2)
note2.RedisplayObject()
ElseIf Text1(0) = "<W@DB_JOB_NUMBER>" Or Text1(0) = "<W@$SH_SHEET_NUMBER> <W@$SH_NUMBER_OF_SHEETS>" Then
Dim lineAndArrowPreferences3 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences3 = note2.GetLineAndArrowPreferences()
Dim letteringPreferences3 As Annotations.LetteringPreferences
letteringPreferences3 = note2.GetLetteringPreferences()
Dim fontIndex1 As Integer
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")
' Font is associated with integer 4
Dim generalText3 As Annotations.Lettering
generalText3.Size = 0.09
generalText3.CharacterSpaceFactor = 1.0
generalText3.AspectRatio = 1.0
generalText3.LineSpaceFactor = 1.0
generalText3.Cfw.Color = 2
generalText3.Cfw.Font = 51
generalText3.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences3.SetGeneralText(generalText3)
note2.SetLetteringPreferences(letteringPreferences3)
note2.RedisplayObject()
ElseIf Text1(0) = "<W@DB_PART_NAME>" Then
Dim lineAndArrowPreferences4 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences4 = note2.GetLineAndArrowPreferences()
Dim letteringPreferences4 As Annotations.LetteringPreferences
letteringPreferences4 = note2.GetLetteringPreferences()
Dim fontIndex1 As Integer
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")
' Font is associated with integer 4
Dim generalText3 As Annotations.Lettering
generalText3.Size = 0.125
generalText3.CharacterSpaceFactor = 1.0
generalText3.AspectRatio = 1.0
generalText3.LineSpaceFactor = 1.0
generalText3.Cfw.Color = 2
generalText3.Cfw.Font = 51
generalText3.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences4.SetGeneralText(generalText3)
note2.SetLetteringPreferences(letteringPreferences4)
note2.RedisplayObject()
End If
Next
'Update Dimension and appended text
Dim Dimension1 As Dimension
For Each Dimension1 In workPart.Dimensions
Dim dimensionPreferences1 As Annotations.DimensionPreferences
dimensionPreferences1 = Dimension1.GetDimensionPreferences()
Dim letteringPreferences5 As Annotations.LetteringPreferences
letteringPreferences5 = Dimension1.GetLetteringPreferences()
Dim fontIndex1 As Integer
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")
' Font is associated with integer 3
Dim dimensionText1 As Annotations.Lettering
dimensionText1.Size = 0.1
dimensionText1.CharacterSpaceFactor = 2.0
dimensionText1.AspectRatio = 1.0
dimensionText1.LineSpaceFactor = 1.0
dimensionText1.Cfw.Color = 6
dimensionText1.Cfw.Font = 51
dimensionText1.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences5.SetDimensionText(dimensionText1)
letteringPreferences5.SetAppendedText(dimensionText1)
letteringPreferences5.SetToleranceText(dimensionText1)
Dimension1.SetLetteringPreferences(letteringPreferences5)
Dim lineAndArrowPreferences1 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences1 = Dimension1.GetLineAndArrowPreferences()
dimensionPreferences1.Dispose()
letteringPreferences5.Dispose()
Dimension1.RedisplayObject()
Next
'Update all Id symbols Line and Arrow preferences not included as User need different Arrowheads
For Each Idsymbol1 As Annotations.IdSymbol In workPart.Annotations.IdSymbols
Dim symbolPreferences1 As Annotations.SymbolPreferences
symbolPreferences1 = Idsymbol1.GetSymbolPreferences()
Dim lineAndArrowPreferences1 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences1 = Idsymbol1.GetLineAndArrowPreferences()
Dim letteringPreferences6 As Annotations.LetteringPreferences
letteringPreferences6 = Idsymbol1.GetLetteringPreferences()
Dim generalText4 As Annotations.Lettering
generalText4.Size = 0.1
generalText4.CharacterSpaceFactor = 1.0
generalText4.AspectRatio = 1.0
generalText4.LineSpaceFactor = 1.0
generalText4.Cfw.Color = 6
generalText4.Cfw.Font = 51
generalText4.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences6.SetGeneralText(generalText4)
Idsymbol1.SetLetteringPreferences(letteringPreferences6)
symbolPreferences1.IdSymbolSize = 0.35
Idsymbol1.SetSymbolPreferences(symbolPreferences1)
letteringPreferences6.Dispose()
lineAndArrowPreferences1.Dispose()
symbolPreferences1.Dispose()
Idsymbol1.RedisplayObject()
Next
'Update Label Font for all the Labels not letter size factor
Dim NULL_TAG As NXOpen.Tag = NXOpen.Tag.Null
Dim obj As NXOpen.Tag = NULL_TAG
Do
obj = ask_next_drf_entity(obj)
If obj = NULL_TAG Then
GoTo end1
End If
' Check whether returned Tag is UF_draft_label_subtype
Dim type As Integer = Nothing
Dim subtype As Integer = Nothing
ufs.Obj.AskTypeAndSubtype(obj, type, subtype)
Dim nxobj As NXObject = NXObjectManager.Get(obj)
If nxobj.GetType().ToString() <> "NXOpen.Annotations.Label" Then
Continue Do
Else
Dim Label1 As Annotations.Label = nxobj
Dim letteringPreferences7 As Annotations.LetteringPreferences
letteringPreferences7 = Label1.GetLetteringPreferences()
Dim generalText5 As Annotations.Lettering
generalText5.Size = 0.1
generalText5.CharacterSpaceFactor = 1.0
generalText5.AspectRatio = 1.0
generalText5.LineSpaceFactor = 1.0
generalText5.Cfw.Color = 6
generalText5.Cfw.Font = 51
generalText5.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences7.SetGeneralText(generalText5)
Label1.SetLetteringPreferences(letteringPreferences7)
letteringPreferences7.Dispose()
Label1.RedisplayObject()
End If
Loop Until obj = NULL_TAG
End1:
Dim NULL_TAG1 As NXOpen.Tag = NXOpen.Tag.Null
Dim obj1 As NXOpen.Tag = NULL_TAG1
Do
obj1 = Ask_Tab_note(obj1)
If obj1 = NULL_TAG1 Then
GoTo end2
End If
' Check whether returned Tag is UF_draft_label_subtype
Dim type As Integer = Nothing
Dim subtype As Integer = Nothing
ufs.Obj.AskTypeAndSubtype(obj1, type, subtype)
Dim nxobj1 As NXObject = NXObjectManager.Get(obj1)
If obj1.GetType().ToString() <> "Tabular Note Cell" Then
Continue Do
Else
Dim Cell1 As Annotations.Note = nxobj1
Dim letteringPreferences8 As Annotations.LetteringPreferences
letteringPreferences8 = Cell1.GetLetteringPreferences()
Dim generalText6 As Annotations.Lettering
generalText6.Size = 0.3
generalText6.CharacterSpaceFactor = 1.0
generalText6.AspectRatio = 1.0
generalText6.LineSpaceFactor = 1.0
generalText6.Cfw.Color = 6
generalText6.Cfw.Font = 51
generalText6.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences8.SetGeneralText(generalText6)
Cell1.SetLetteringPreferences(letteringPreferences8)
letteringPreferences8.Dispose()
'Dim cellPrefs1 As UFTabnot.CellPrefs
'cellPrefs1 = Cell1.getcellPrefs
'cellPrefs1.format = UFTabnot.Format.FormatText
'cellPrefs1.text_font = 51
'cellPrefs1.text_height = 0.06
'cellPrefs1.text_aspect_ratio = 1.0 '
'cellPrefs1.text_angle = 0.0
'cellPrefs1.text_slant = 0.0
'cellPrefs1.line_space_factor = 1.0
'cellPrefs1.char_space_factor = 1.0
'cellPrefs1.text_color = 6
'cellPrefs1.text_density = "Thin"
'cellPrefs1 = Cell1.SetcellPrefs
Cell1.RedisplayObject()
End If
Loop Until obj1 = NULL_TAG1
End2:
End Sub
Public Function Ask_Tab_note(ByRef obj1 As NXOpen.Tag) As NXOpen.Tag
Dim part As NXOpen.Tag = workPart.Tag
ufs.Obj.CycleObjsInPart(part, UFConstants.UF_tabular_note_cell_subtype, obj1)
Return obj1
End Function
Public Function GetUnloadOption(ByVal dummy As String) As Integer
'Unloads the image immediately after execution within NX
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
End Function
Public Function ask_next_drf_entity(ByRef obj As NXOpen.Tag) As NXOpen.Tag
Dim part As NXOpen.Tag = Workpart.Tag
ufs.Obj.CycleObjsInPart(part, UFConstants.UF_drafting_entity_type, obj)
Return obj
End Function
End Module