Regard - Annonation

we have NX drawing, those drawing has many ballooning annotation for the parts, but we need check those balloons as per our Standards, say example in the entire drawing i have to check baloon which are not following our style.
How to filter through those ballon annotations in the drawing file
There are diffrent style available
X,Y, & Z, but our drawing must use X style of balloon annotation in the drawing whichever not in the X style has to be highlighted in RED color
I have gone through net searching for any example in VB.NET for NX Open application regard annotation.
I couldn't
Please help me with example.
regards,
Gopal Parthasarathy

What version of NX are you using and what type of differences are you looking for in the symbols (circle vs triangle, size difference, arrow type, etc etc)?

Here is a quick journal that will return some symbol information. It was made with NX 8.5 in mind, your mileage may vary.

When you find a symbol that does not match the style you want, why not adjust the style in the journal rather than just coloring it red?

Option Strict Off
Imports System
Imports NXOpen

Module IDSymbol_info

Sub Main()

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim lw As ListingWindow = theSession.ListingWindow
lw.Open()

Dim myIdBuilder As Annotations.IdSymbolBuilder

If workPart.Annotations.IdSymbols.ToArray.Length = 0 Then
lw.WriteLine("No ID symbols found in current work part")
Return
End If

For Each tempID As Annotations.IdSymbol In workPart.Annotations.IdSymbols

myIdBuilder = workPart.Annotations.IdSymbols.CreateIdSymbolBuilder(tempID)
lw.WriteLine("origin: " & myIdBuilder.Origin.OriginPoint.ToString)
lw.WriteLine("upper text: " & myIdBuilder.UpperText)
lw.WriteLine("style: " & myIdBuilder.Type.ToString)
lw.WriteLine("size: " & myIdBuilder.Size.ToString)
lw.WriteLine("arrow type: " & tempID.GetLineAndArrowPreferences.FirstArrowType.ToString)
lw.WriteLine("stub length: " & tempID.GetLineAndArrowPreferences.StubLength.ToString)
lw.WriteLine("")

Next

End Sub

End Module

we are using UG NX 7.5, Yes ur rite instead of color change, it can changed into required style.
I need to do ask user acceptance for the change, if they ok, it will change into diffrent style.
can I get the modification in above program as i said above
Thanks and regards
Gopal Parthasarathy

Gopal Parthasarathy
CERT/FEA Engineer
B/E Aerospace

In addition to the details of the balloon (location on page, size, text, etc), is there a way to retrieve the nominal and tolerance values of a dimension associated with the balloon?

thanks,
Patch

If you have a reference to the ID symbol, I'd suggest using the .NumberOfAssociativities property and the .GetAssociativity() method. I've not tried it yet, but I'd think you'd be able to get a reference to the dimension it is associated to (if any). Once you have a reference to the dimension, you can query it for the value and tolerances.

Does the code above give you enough to go on, or would you like more specific code?

If you'd like more code, what specific properties of the ID symbols need to be checked, and what are the desired values of these properties?

In my model I have two styles in annotation one is triangleup, and Circle, But I want to convert all triangleup as circle in the drawing.
So I wrote additional commands as
Dim xtr as string

after lw.Writeline in for statement
i have assigned xtr = myIdBuilder.Type.ToString
if xtr = TriangleUp Then
myIdBuilder.Type.ToString = Circle
end if
When Iam running this NX says that error in circle variable
can you justify am I correct or Not
regards,
Gopal Parthasarathy

Gopal Parthasarathy
CERT/FEA Engineer
B/E Aerospace

Are you commiting the changes to the ID Symbol after you change the type?
Something like this:

Dim nXObject1 As Annotations.IdSymbol
nXObject1 = myIdBuilder.Commit()

Also shouldn't type be changed as:

myIdBuilder.Type = Annotations.IdSymbolBuilder.SymbolTypes.Circle

I have requirement that in my drawing sheet I want to highlight dimension annotation text size which diffrent from 0.125 in red, as well i want to highlight annotation font style which diffrent from "xyz" style in Green colour in my drawing sheet.
later user will select and change into as per their requirement.
regards,
Gopal parthasarathy

Gopal Parthasarathy
CERT/FEA Engineer
B/E Aerospace

Really quick and dirty. Should get you started though.

Imports System
Imports NXOpen
Imports NXOpen.UF

Module Check_Dimensions

Sub Main()

Dim theSession As Session = Session.GetSession()
Dim theUfSession As UFSession = UFSession.GetUFSession()
Dim lw As ListingWindow = theSession.ListingWindow
Dim displayPart As Part = theSession.Parts.Display
Dim workPart As Part = theSession.Parts.Work

lw.Open()

For Each FoundDimension As Annotations.Dimension In workPart.Dimensions

theUfSession.Drf.IsAnnotationRetained(FoundDimension.Tag(), isRetained)

Dim mpi(99) As Integer
Dim mpr(69) As Double
Dim radius_val As String
Dim diameter_val As String

theUfSession.Drf.AskObjectPreferences(FoundDimension.Tag, mpi, mpr, radius_val, diameter_val)

lw.Writeline("Color: " & mpi(78))
lw.Writeline("Font: " & mpi(79))
lw.Writeline("Height: " & mpr(32))

'If statements for font and size go here. If not correct size or color change the color value to the colors of your choosing. As far as I know there is no color setting available for the highlight command.'

theUfSession.Drf.SetObjectPreferences(basicDim.Tag, mpi, mpr, radius_val, diameter_val)

Next

End Sub

Public Function GetUnloadOption(ByVal dummy As String) As Integer
Return Session.LibraryUnloadOption.Immediately
End Function

End Module

When i runnig above program, Iam getting following error during compilation
Line 13: Name 'isRetained' is not declared
Line 23: Name 'basicDim' is not declared
If i want to check annotation dimension text
Can I write like this
Dim hei as double
hei = FoundDimension.mpr(32)
before that I want to know what mpr(32) means to get the value of height
if hei = 0.125 then
FoundDimension.color = 6
endif
is that above codes are ok.
If not please help me
regards,
Gopal Parthasarathy

Gopal Parthasarathy
CERT/FEA Engineer
B/E Aerospace

The code below will loop through the dimensions in the work part; if the text height <> 0.125, it will change the dimension text to color #6.


Option Strict Off
Imports System
Imports NXOpen

Module set_dim_text_height
Sub Main()

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, "change dim color")
Dim numBad As Integer = 0

For Each tempDim As Annotations.Dimension In workPart.Dimensions

Dim letteringPreferences1 As Annotations.LetteringPreferences
letteringPreferences1 = tempDim.GetLetteringPreferences()

Dim dimensionText1 As Annotations.Lettering = letteringPreferences1.GetDimensionText

If dimensionText1.Size <> 0.125 Then
numBad += 1
'change text size, if desired...
'dimensionText1.Size = 0.125
dimensionText1.Cfw.Color = 6

letteringPreferences1.SetDimensionText(dimensionText1)

End If

tempDim.SetLetteringPreferences(letteringPreferences1)

letteringPreferences1.Dispose()

Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.DoUpdate(markId1)

Next

If numBad > 0 Then
theSession.SetUndoMarkVisibility(markId1, "change dim color", Session.MarkVisibility.Visible)
End If

End Sub
End Module

Changing an ID symbol type (e.g. triangle to circle) is more difficult; you can't change the type of an existing symbol. To get around this, we'll have to create a new symbol of the desired type and delete the old one.

Below is one way to code this approach (should cover most cases, not heavily tested).

Option Strict Off
Imports System
Imports NXOpen

Module change_id_symbol_type

Sub Main()

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim lw As ListingWindow = theSession.ListingWindow
lw.Open()

If workPart.Annotations.IdSymbols.ToArray.Length = 0 Then
lw.WriteLine("No ID symbols found in current work part")
Return
End If

For Each tempID As Annotations.IdSymbol In workPart.Annotations.IdSymbols

Dim myIdBuilder As Annotations.IdSymbolBuilder

myIdBuilder = workPart.Annotations.IdSymbols.CreateIdSymbolBuilder(tempID)

If myIdBuilder.Type = Annotations.IdSymbolBuilder.SymbolTypes.TriangleUp Then
Dim nullSymbol As Annotations.IdSymbol = Nothing
Dim newIdBuilder As Annotations.IdSymbolBuilder
newIdBuilder = workPart.Annotations.IdSymbols.CreateIdSymbolBuilder(nullSymbol)

newIdBuilder.Type = Annotations.IdSymbolBuilder.SymbolTypes.Circle
newIdBuilder.Size = myIdBuilder.Size
newIdBuilder.UpperText = myIdBuilder.UpperText
newIdBuilder.LowerText = myIdBuilder.LowerText
newIdBuilder.Style.LetteringStyle.AlignPosition = myIdBuilder.Style.LetteringStyle.AlignPosition
newIdBuilder.Origin.Anchor = myIdBuilder.Origin.Anchor
newIdBuilder.Origin.SetAssociativeOrigin(myIdBuilder.Origin.GetAssociativeOrigin)
newIdBuilder.Leader.Leaders.SetContents(myIdBuilder.Leader.Leaders.GetContents)

newIdBuilder.Origin.OriginPoint = myIdBuilder.Origin.OriginPoint

Dim newSymbol As NXObject
Try
newSymbol = newIdBuilder.Commit
myIdBuilder.Destroy()

'now delete the old symbol
theSession.UpdateManager.ClearErrorList()

Dim markId3 As Session.UndoMarkId
markId3 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, "Delete old symbol")

Dim objects1(0) As NXObject

objects1(0) = tempID
Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.AddToDeleteList(objects1)

Dim nErrs2 As Integer
nErrs2 = theSession.UpdateManager.DoUpdate(markId3)

Catch ex As NXException
MsgBox(ex.Message)

Finally
newIdBuilder.Destroy()

End Try

End If

Next

End Sub

End Module

The journal does not work in NX11. It still changes the style of (creates) the balloons, but the old ones are not deleted.

Why do I have to create them new? I tried to change them with tableEditSettingsBuilder, but I do not know how to link the Parts list with the edit command. Is this possible? I would be very greatful if you could explain how to do this.

Best regards

Imports System
Imports NXOpen
Imports NXOpen.UF

Module NXJournal

Dim ufs As UFSession = UFSession.GetUFSession()
Dim theSession As NXOpen.Session = NXOpen.Session.GetSession()

Sub Main (ByVal args() As String)

Dim workPart As NXOpen.Part = theSession.Parts.Work
Dim displayPart As NXOpen.Part = theSession.Parts.Display

Dim my_plist As NXOpen.Tag = NXOpen.Tag.Null

Dim dispPart As NXOpen.Tag = theSession.Parts.Display.Tag

my_plist = GetPlistTag(dispPart)

Dim objects1(0) As NXOpen.DisplayableObject
Dim tableSection As NXOpen.Annotations.TableSection

ufs.Tabnot.AskNthSection(my_plist, 0, tableSection)
'This is not working unfortunately

'dim TaggedObject1 as TaggedObject = NXOpen.Utilities.NXObjectManager.Get(tableSection)

objects1(0) = tableSection

Dim tableEditSettingsBuilder1 As NXOpen.Annotations.TableEditSettingsBuilder = Nothing

tableEditSettingsBuilder1 = workPart.SettingsManager.CreateTableEditSettingsBuilder(objects1)

tableEditSettingsBuilder1.TableSection.ApplyToAllSections = True

Dim editsettingsbuilders1(0) As NXOpen.Drafting.BaseEditSettingsBuilder

editsettingsbuilders1(0) = tableEditSettingsBuilder1

workPart.SettingsManager.ProcessForMultipleObjectsSettings(editsettingsbuilders1)

tableEditSettingsBuilder1.PartsList.Symbol = NXOpen.Annotations.PartsListBuilder.PartsListSymbolType.Square

Dim nXObject1 As NXOpen.NXObject = Nothing

nXObject1 = tableEditSettingsBuilder1.Commit()

tableEditSettingsBuilder1.Destroy()

End Sub

Public Function GetPlistTag(ByRef partTag As NXOpen.Tag) As NXOpen.Tag

Dim tempTag As NXOpen.Tag = NXOpen.Tag.Null
Dim type As Integer
Dim subtype As Integer

Do
ufs.Obj.CycleObjsInPart(partTag, _
UFConstants.UF_tabular_note_type, tempTag)
ufs.Obj.AskTypeAndSubtype(tempTag, type, subtype)
If subtype = UFConstants.UF_parts_list_subtype Then
Return tempTag
End If

Loop Until tempTag = NXOpen.Tag.Null

End Function

End Module

The code that deletes and recreates the balloons is NOT meant to be used with part list callout balloons. It was made to help with changing the style of individual (not used by a parts list) ID symbols. In older versions of NX, there was no way to edit a balloon shape after it was created.

If you are changing the shape of parts list callout balloons, you are correct to use the TableEditSettingsBuilder. I tweaked your code to find the parts list automatically and pass it to the builder.

Imports System
Imports NXOpen
Imports NXOpen.UF

Module NXJournal

Dim ufs As UFSession = UFSession.GetUFSession()
Dim theSession As NXOpen.Session = NXOpen.Session.GetSession()

Sub Main (ByVal args() As String)

Dim workPart As NXOpen.Part = theSession.Parts.Work
Dim displayPart As NXOpen.Part = theSession.Parts.Display

Dim my_plist As NXOpen.Tag = NXOpen.Tag.Null

my_plist = GetPlistTag(displayPart.Tag)

Dim objects1(0) As NXOpen.DisplayableObject
Dim tableSection1 As NXOpen.Annotations.TableSection
Dim tableSectionTag as NXOpen.Tag = Tag.Null

ufs.Tabnot.AskNthSection(my_plist, 0, tableSectionTag)

tableSection1 = NXOpen.Utilities.NXObjectManager.Get(tableSectionTag)

objects1(0) = tableSection1

Dim tableEditSettingsBuilder1 As Annotations.TableEditSettingsBuilder
tableEditSettingsBuilder1 = workPart.SettingsManager.CreateTableEditSettingsBuilder(objects1)

tableEditSettingsBuilder1.TableSection.ApplyToAllSections = True

tableEditSettingsBuilder1.PartsList.Symbol = Annotations.PartsListBuilder.PartsListSymbolType.Square

Dim nXObject1 As NXObject
nXObject1 = tableEditSettingsBuilder1.Commit()

tableEditSettingsBuilder1.Destroy()

End Sub

Public Function GetPlistTag(ByRef partTag As NXOpen.Tag) As NXOpen.Tag

Dim tempTag As NXOpen.Tag = NXOpen.Tag.Null
Dim type As Integer
Dim subtype As Integer

Do
ufs.Obj.CycleObjsInPart(partTag, _
UFConstants.UF_tabular_note_type, tempTag)
ufs.Obj.AskTypeAndSubtype(tempTag, type, subtype)
If subtype = UFConstants.UF_parts_list_subtype Then
Return tempTag
End If

Loop Until tempTag = NXOpen.Tag.Null

End Function

End Module

the belwo program I changed into for all dimension verification that any dimension text height which are not equal to 0.125 shoul be changed into 0.125 text Height.
Option Strict Off
Imports System
Imports NXOpen

Module set_dim_text_height
Sub Main()

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, "change dim color")
Dim numBad As Integer = 0

Dim xtr as string

For Each tempDim As Annotations.Dimension In workPart.Dimensions
msgbox("hi")
Dim Dimension1 As Annotations.Dimension = CType(workPart.FindObject("ENTITY 26 1 1"), Annotations.Dimension)

Dim letteringPreferences1 As Annotations.LetteringPreferences
letteringPreferences1 = tempDim.GetLetteringPreferences()

Dim dimensionText1 As Annotations.Lettering = letteringPreferences1.GetDimensionText

If dimensionText1.Size <> 0.125 Then
numBad += 1
msgbox("Text")
'change text size, if desired...
msgbox(Str$(dimensionText1.Size))
'msgbox(dimensionText1.GetDimensionText())
dimensionText1.Size = 0.125
dimensionText1.Cfw.Color = 3

letteringPreferences1.SetDimensionText(dimensionText1)

End If

Dimension1.SetLetteringPreferences(letteringPreferences1)

letteringPreferences1.Dispose()

Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.DoUpdate(markId1)

Next

If numBad > 0 Then
theSession.SetUndoMarkVisibility(markId1, "change dim color", Session.MarkVisibility.Visible)
End If

End Sub
End Module
But in my model, it's not updating text as per my dimension as well I have three different dimension text, it's running with two only but coming out before checking the third dimension text in FOR Each loop, an one more i want to extract the content of dimension text character.
please change the code for my requirement
regards,
Gopal parthasrathy

Gopal Parthasarathy
CERT/FEA Engineer
B/E Aerospace

I want to know the purpose of UndomarkID.
In the above program.
Regards
Gopal parthasarathy

Gopal Parthasarathy
CERT/FEA Engineer
B/E Aerospace

The code below will change the text height to 0.125 and show a messagebox of the first dimension text line for any dimensions that do not have a text height of 0.125.

By creating an undo mark, you will have the opportunity to undo any changes the journal made. After running the journal, go to Edit -> Undo List; if the journal made any changes, you will see an undo entry named "change dim color" (previous code) or "change dim text height" (code below).


Option Strict Off
Imports System
Imports NXOpen

Module set_dim_text_height
Sub Main()

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, "change dim text height")
Dim numBad As Integer = 0

For Each tempDim As Annotations.Dimension In workPart.Dimensions

Dim letteringPreferences1 As Annotations.LetteringPreferences
letteringPreferences1 = tempDim.GetLetteringPreferences()

Dim dimensionText1 As Annotations.Lettering = letteringPreferences1.GetDimensionText

If dimensionText1.Size <> 0.125 Then
numBad += 1
'change text size, if desired...
dimensionText1.Size = 0.125
'dimensionText1.Cfw.Color = 6

Dim mainText() As String
Dim dualText() As String
tempDim.GetDimensionText(mainText, dualText)
MsgBox("dim text (main line 1): " & mainText(0))

letteringPreferences1.SetDimensionText(dimensionText1)

End If

tempDim.SetLetteringPreferences(letteringPreferences1)

letteringPreferences1.Dispose()

Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.DoUpdate(markId1)

Next

If numBad > 0 Then
theSession.SetUndoMarkVisibility(markId1, "change dim text height", Session.MarkVisibility.Visible)
End If

End Sub
End Module

How to make this VB code to run just to press button in NX window.
Means how to create GUI button and connect this code to run whenever I click this button.
regards,
Gopal Parthasarathy

Gopal Parthasarathy
CERT/FEA Engineer
B/E Aerospace

Above same program, I want to extract the information of dimension text style name.
Say dimension text are created using style "XXX" how to retrive the name of style and layer in which the dimension text are placed.
regards,
Gopal parthasarathy

Gopal Parthasarathy
CERT/FEA Engineer
B/E Aerospace

In the above program I want to change the color of entire dimension entity in diffrent color.
I have called Annotations.color=7; but it's quit with error.
Pls can you help me
Regards,
Gopal Parthasarathy

Gopal Parthasarathy
CERT/FEA Engineer
B/E Aerospace

Below is code that will report the font and layer of the dimension. Also, I have added a function that will change the dimension color. If you want to change the font, you will need to use the methods in the fontCollection to query the proper font number and assign it to the dimension text preferences.



Option Strict Off
Imports System
Imports NXOpen

Module set_dim_text_height

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work

Sub Main()

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, "change dim text height")
Dim numBad As Integer = 0

For Each tempDim As Annotations.Dimension In workPart.Dimensions

Dim letteringPreferences1 As Annotations.LetteringPreferences
letteringPreferences1 = tempDim.GetLetteringPreferences()

Dim dimensionText1 As Annotations.Lettering = letteringPreferences1.GetDimensionText

Dim mainText() As String
Dim dualText() As String
tempDim.GetDimensionText(mainText, dualText)

Dim dimFont As Integer = dimensionText1.Cfw.Font
MsgBox("dim text (main line 1): " & mainText(0) & ControlChars.CrLf & _
"dimension font: " & workPart.Fonts.GetFontName(dimFont) & ControlChars.CrLf & _
"on layer: " & tempDim.Layer.ToString)

If dimensionText1.Size <> 0.125 Then
numBad += 1
'change text size, if desired...
dimensionText1.Size = 0.125
'dimensionText1.Cfw.Color = 6

letteringPreferences1.SetDimensionText(dimensionText1)

End If

tempDim.SetLetteringPreferences(letteringPreferences1)

letteringPreferences1.Dispose()

Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.DoUpdate(markId1)

ChangeDimColor(tempDim, 6)

Next

If numBad > 0 Then
theSession.SetUndoMarkVisibility(markId1, "change dim text height", Session.MarkVisibility.Visible)
End If

End Sub

Function ChangeDimColor(ByRef theDim As Annotations.Dimension, ByVal newColor As Integer) As Boolean

If newColor < 1 OrElse newColor > 216 Then
Throw New System.Exception("color value must be between 1 and 216 inclusive")
Return False
End If

Dim markId1 As Session.UndoMarkId
Const undoName As String = "change dim color"
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, undoName)

'***** change line and arrow color *****
Dim lineAndArrowPreferences1 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences1 = theDim.GetLineAndArrowPreferences()

Dim firstExtensionLineCfw1 As Annotations.LineCfw
firstExtensionLineCfw1 = lineAndArrowPreferences1.GetFirstExtensionLineCfw
firstExtensionLineCfw1.Color = newColor
lineAndArrowPreferences1.SetFirstExtensionLineCfw(firstExtensionLineCfw1)

Dim firstArrowheadCfw1 As Annotations.LineCfw
firstArrowheadCfw1 = lineAndArrowPreferences1.GetFirstArrowheadCfw
firstArrowheadCfw1.Color = newColor
lineAndArrowPreferences1.SetFirstArrowheadCfw(firstArrowheadCfw1)

Dim firstArrowLineCfw1 As Annotations.LineCfw
firstArrowLineCfw1 = lineAndArrowPreferences1.GetFirstArrowLineCfw
firstArrowLineCfw1.Color = newColor
lineAndArrowPreferences1.SetFirstArrowLineCfw(firstArrowLineCfw1)

Dim secondExtensionLineCfw1 As Annotations.LineCfw
secondExtensionLineCfw1 = lineAndArrowPreferences1.GetSecondExtensionLineCfw
secondExtensionLineCfw1.Color = newColor
lineAndArrowPreferences1.SetSecondExtensionLineCfw(secondExtensionLineCfw1)

Dim secondArrowheadCfw1 As Annotations.LineCfw
secondArrowheadCfw1 = lineAndArrowPreferences1.GetSecondArrowheadCfw
secondArrowheadCfw1.Color = newColor
lineAndArrowPreferences1.SetSecondArrowheadCfw(secondArrowheadCfw1)

Dim secondArrowLineCfw1 As Annotations.LineCfw
secondArrowLineCfw1 = lineAndArrowPreferences1.GetSecondArrowLineCfw
secondArrowLineCfw1.Color = newColor
lineAndArrowPreferences1.SetSecondArrowLineCfw(secondArrowLineCfw1)

theDim.SetLineAndArrowPreferences(lineAndArrowPreferences1)

lineAndArrowPreferences1.Dispose()
'***** end change line and arrow color *****

'***** change text color *****
Dim letteringPreferences1 As Annotations.LetteringPreferences
letteringPreferences1 = theDim.GetLetteringPreferences()

Dim dimensionText1 As Annotations.Lettering = letteringPreferences1.GetDimensionText

dimensionText1.Cfw.Color = newColor
letteringPreferences1.SetDimensionText(dimensionText1)
theDim.SetLetteringPreferences(letteringPreferences1)

letteringPreferences1.Dispose()
'***** end change text color *****

Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.DoUpdate(markId1)

theSession.DeleteUndoMark(markId1, undoName)

Return True

End Function

End Module

Assuming you want to change the color of every element in the dimension to the same value, the function "ChangeDimColor" in the code above can be simplified to:



Function ChangeDimColor(ByRef theDim As Annotations.Dimension, ByVal newColor As Integer) As Boolean

If newColor < 1 OrElse newColor > 216 Then
Throw New System.Exception("color value must be between 1 and 216 inclusive")
Return False
End If

Dim markId1 As Session.UndoMarkId
Const undoName As String = "change dim color"
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, undoName)

Dim displayModification1 As DisplayModification
displayModification1 = theSession.DisplayManager.NewDisplayModification()

displayModification1.NewColor = newColor

Dim objects1(0) As DisplayableObject
objects1(0) = theDim
displayModification1.Apply(objects1)

displayModification1.Dispose()

Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.DoUpdate(markId1)

theSession.DeleteUndoMark(markId1, undoName)

Return True

End Function



If you want to change the colors of the extension lines, arrows, or text individually, you would need something similar to the original code.