Regard - Annonation

Submitted by Gopal Parthasarathy on Tue, 01/28/2014 - 09:50
Forums: 
Journaling / NXOpen API

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

NXJournaling - Tue, 01/28/2014 - 11:01

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)?

NXJournaling - Tue, 01/28/2014 - 11:25

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

Gopal Parthasarathy - Wed, 01/29/2014 - 04:37

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

patch - Mon, 03/02/2015 - 10:13

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

NXJournaling - Mon, 03/02/2015 - 11:10

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.

NXJournaling - Wed, 01/29/2014 - 07:27

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?

Gopal Parthasarathy - Wed, 01/29/2014 - 09:30

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

iamfallen - Wed, 01/29/2014 - 10:06

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()

iamfallen - Wed, 01/29/2014 - 10:10

Also shouldn't type be changed as:

myIdBuilder.Type = Annotations.IdSymbolBuilder.SymbolTypes.Circle

Gopal Parthasarathy - Wed, 01/29/2014 - 10:47

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

iamfallen - Wed, 01/29/2014 - 11:33

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

Gopal Parthasarathy - Fri, 01/31/2014 - 10:04

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

NXJournaling - Fri, 01/31/2014 - 14:11

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

NXJournaling - Fri, 01/31/2014 - 14:15

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

Robse-ponte - Wed, 02/14/2018 - 15:22

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

NXJournaling - Thu, 02/15/2018 - 05:46

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

Gopal Parthasarathy - Mon, 02/03/2014 - 08:50

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

Gopal Parthasarathy - Mon, 02/03/2014 - 09:07

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

Gopal Parthasarathy
CERT/FEA Engineer
B/E Aerospace

NXJournaling - Mon, 02/03/2014 - 11:02

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

Gopal Parthasarathy - Tue, 02/04/2014 - 06:53

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

NXJournaling - Tue, 02/04/2014 - 07:38

Refer to this article:

http://nxjournaling.com/?q=content/start-journal-custom-button

Gopal Parthasarathy - Tue, 02/11/2014 - 04:44

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

Gopal Parthasarathy - Tue, 02/11/2014 - 04:56

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

NXJournaling - Tue, 02/11/2014 - 07:33

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

NXJournaling - Fri, 02/14/2014 - 08:52

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.