Submitted by Gopal Parthasarathy on Tue, 01/28/2014 - 09:50
Forums:
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
re: ID Symbols
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)?
symbol info
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
Regard Annotation
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
how to retrieve dimension associated with a balloon?
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
re: dim associated to balloon
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.
re: ID Symbols
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?
Regard Annotation
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
Committing the change?
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()
Changing type
Also shouldn't type be changed as:
myIdBuilder.Type = Annotations.IdSymbolBuilder.SymbolTypes.Circle
Regard Annotation
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
Dimension font size and style.
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
Regard Annotation
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
re: dimension text height
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
re: change ID symbol type
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
Not working in NX11
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
re: change balloon type
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
Regard Annotation
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
Regard Annotation
I want to know the purpose of UndomarkID.
In the above program.
Regards
Gopal parthasarathy
Gopal Parthasarathy
CERT/FEA Engineer
B/E Aerospace
re: dim text height
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
Regard Annotation
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
re: start journal from custom button
Refer to this article:
http://nxjournaling.com/?q=content/start-journal-custom-button
Regard Annotation
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
Regard Annotation
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
re: dim font and color
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
re: simplification
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.