Journaling help needed - Colouring and defining attributes

[Nome737]

Hello together

I have seen the following post for colouring surfaces.

https://www.eng-tips.com/viewthread.cfm?qid=473648#post

Option Strict Off

Imports System
Imports NXOpen
Imports NXOpen.UF
Imports NXOpenUI


Module changeColorOfPreSelectedFaces_v2

	Dim theSession As Session = Session.GetSession()
	Dim sel As Selection = NXOpen.UI.GetUI.SelectionManager

Sub Main()

	'' Integer variable to store color code in.
	Dim newColorCode As Integer = 114

	newColorCode = Convert.ToInt32(211)
 
	'' The selectFaces method takes an NXobject array by reference 
	Dim selectedObjectsArray() As NXObject
	SelectFaces(selectedObjectsArray)

	'' Need to recast the face NXObjects to Displayable objects
	Dim faceArray(selectedObjectsArray.Length - 1) As DisplayableObject
	
	For i As Integer = 0 To selectedObjectsArray.Length - 1
	
		faceArray(i) = CType(selectedObjectsArray(i), DisplayableObject)
			
	Next

	'' A display modification object is used to change to color of the faces.
	Dim changeFaceColor As DisplayModification = theSession.DisplayManager.NewDisplayModification()
	
	With changeFaceColor
		.ApplyToAllFaces = False
		.NewColor = newColorCode
		.Apply(faceArray)
		.Dispose()	
	End With

End Sub


Sub SelectFaces(ByRef selectedObjects As NXObject())

	Dim ui As UI = NXOpen.UI.GetUI
	Dim message As String = "Select faces"
	Dim title As String = "Select faces"
	Dim scope As Selection.SelectionScope = Selection.SelectionScope.WorkPart
	Dim keepHighlighted As Boolean = False
	Dim includeFeatures As Boolean = False
	Dim response As Selection.Response
	Dim selectionAction As Selection.SelectionAction = Selection.SelectionAction.ClearAndEnableSpecific
	Dim selectionMask_array(0) As Selection.MaskTriple
	
	With selectionMask_array(0)
		.Type = UFConstants.UF_solid_type
		.Subtype = 0
		.SolidBodySubtype = UFConstants.UF_UI_SEL_FEATURE_ANY_FACE
	End With

	Response = ui.SelectionManager.SelectObjects(message, title, scope, selectionAction, includeFeatures, _
			keepHighlighted, selectionMask_array, selectedObjects)

	If response = Selection.Response.Cancel Or response = Selection.Response.Back Then
	
		Return
		
	End If

End Sub

Public Function GetUnloadOption(ByVal dummy As String) As Integer

	GetUnloadOption = NXOpen.UF.UFConstants.UF_UNLOAD_IMMEDIATELY

End Function

End Module

Is it possible to extend this journal by assigning an attribute to the selected surfaces?

Thank you very much for jour help!

Nome

 

[RX8UK]

Hi Nome,

To add an attribute "testAttribute" populated as "hello", try the following lines after "End Width" and before the first "End Sub":



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

Dim objectGeneralPropertiesBuilder1 As NXOpen.ObjectGeneralPropertiesBuilder = Nothing
objectGeneralPropertiesBuilder1 = workPart.PropertiesManager.CreateObjectGeneralPropertiesBuilder(selectedObjectsArray)


Dim objects4(-1) As NXOpen.NXObject
Dim attributePropertiesBuilder2 As NXOpen.AttributePropertiesBuilder = Nothing
attributePropertiesBuilder2 = theSession.AttributeManager.CreateAttributePropertiesBuilder(workPart, objects4, NXOpen.AttributePropertiesBuilder.OperationType.None)


attributePropertiesBuilder2.SetAttributeObjects(selectedObjectsArray)

attributePropertiesBuilder2.Title = "testAttribute"

attributePropertiesBuilder2.StringValue = "hello"

Dim changed1 As Boolean = Nothing
changed1 = attributePropertiesBuilder2.CreateAttribute()

Dim nXObject1 As NXOpen.NXObject = Nothing
nXObject1 = objectGeneralPropertiesBuilder1.Commit()

attributePropertiesBuilder2.Destroy()