Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

@robbeRtek

 

Your first option works like my try after you mentioned to highlight the faces via coloring and not with the highlightset. (with the little "Edit")

 

In your second option something must be missing. Cause it shows the same strange behavior of the highlightset that is mentioned in my start post. I also tried to clear an rebuild the whole highlightset. But if there are many faces selected, they will all highlight one after another which looks also very strange.

 

But I found an workaround.

Now every time an already highlighted face is selected (without pressing CTRL), it is removed from the highlightset and will be immediately added back. 

This is not the most elegant solution, but it works (at least for me).

 

I also got rid of the collection cause everything can be done with the highlightset. (thanks to @WCrihfield for this idea). Besides this I also replaced the messagebox for the output with an inputbox as used in the other thread. This gives you the option for "copy and past" for the result.

 

 

Thanks for your help and effort. :thumbs_up:

 

My solution via highlightset:

 

 

 

'Definition
Dim oApp As Inventor.Application = ThisApplication
Dim oDoc As Document = oApp.ActiveDocument
Dim oStartFace,oFace As Inventor.Face '= Nothing
Dim AreaCache As Double = 0
Dim oHSet As HighlightSet = oDoc.CreateHighlightSet()
oHSet.Clear

'if done, start again
TheStart:
On Error GoTo ENDE

While True
	Dim k As Integer
	k = 1
	Dim bNEW As Boolean
	bNEW = True

	oStartFace = oApp.CommandManager.Pick(Inventor.SelectionFilterEnum.kPartFaceFilter, "Fläche anwählen + ""Esc"" bestätigen.") 

	' If nothing gets selected then we're done	
	If IsNothing(oStartFace) Then Exit While
	
	If System.Windows.Forms.Control.ModifierKeys = System.Windows.Forms.Keys.Control Then
		If oHSet.Count>0 Then
			For Each oFace In oHSet
				If oFace.InternalName = oStartFace.InternalName And oFace.TransientKey = oStartFace.TransientKey Then
					bNEW = False
					Exit For
				End If
				k = k + 1
			Next
		End If
		If bNEW = False
			oHSet.Remove(k)
			oApp.ActiveView.Update
		End If
	Else
		If oHSet.Count>0 Then
			For Each oFace In oHSet
				If oFace.InternalName = oStartFace.InternalName And oFace.TransientKey = oStartFace.TransientKey Then
					bNEW = False
					Exit For
				End If
				k = k + 1
			Next
		End If
		If bNEW = True Then
			oHSet.AddItem(oStartFace)
		Else If bNEW = False Then
			oHSet.Remove(k)
			oHSet.AddItem(oStartFace)
		End If
	End If
	''Läuft nicht
	
	oStartFace = Nothing

End While

'For Each oFace In FaceCol
For Each oFace In oHSet
	AreaCache = AreaCache + oFace.Evaluator.Area
Next

If AreaCache = 0 Then Return
AreaCache = Math.Round(AreaCache*100,1)

Dim Auswahl As String

'MessageBox.Show(AreaCache & "mm²")
Auswahl = InputBox("Oberfläche:", "Oberflaeche_berechnen_Multiselect", AreaCache & "mm²")

'MessageBox.Show (Auswahl)
oHSet.Clear
AreaCache = 0

If Auswahl = "" Then Exit Sub

'if done, go to the start
GoTo TheStart

Return
ENDE:

 

 



 

My Solution with changing the color:

 

 

 

'Definition
Dim oApp As Inventor.Application = ThisApplication
Dim oDoc As Document = oApp.ActiveDocument
Dim oEdDoc As Document = oApp.ActiveEditDocument

Dim oCompDef As ComponentDefinition
oCompDef = oDoc.ComponentDefinition

Dim oStartFace,oFace As Inventor.Face '= Nothing
Dim AreaCache As Double = 0
Dim FaceCol As New Collection
FaceCol.Clear
Dim ColorCol As New Collection
ColorCol.Clear
Dim oHSet As HighlightSet = oDoc.CreateHighlightSet()
oHSet.Clear

' Definition der transienten Geometrie
Dim oTransObj As TransientObjects
oTransObj = oApp.TransientObjects

Dim docAsset As Assets
docAsset = oDoc.Assets

Dim oAssetLib As AssetLibrary
oAssetLib = oApp.AssetLibraries.Item("Autodesk Darstellungs-Bibliothek") 'Autodesk Appearance Library

Dim oColor As String
oColor = "Markierung"

' Get an asset In the library
Dim oHighlightColor As Asset

Try 'Copy the asset locally.
	oHighlightColor = docAsset.Item(oColor)
Catch 'or just use it if it's already local
	oHighlightColor = docAsset.Add(AssetTypeEnum.kAssetTypeAppearance, "Generic", oColor, oColor)
	Dim generic_highlight_color As ColorAssetValue
	generic_highlight_color = oHighlightColor.Item("generic_diffuse")
	generic_highlight_color.Value = oHSet.Color

End Try

'wenn fertig, starte von vorn
TheStart:

While True
	Dim k As Integer
	k = 1
	Dim bNEW As Boolean
	bNEW = True
	
	oStartFace = oApp.CommandManager.Pick(Inventor.SelectionFilterEnum.kPartFaceFilter, "Fläche anwählen + ""Esc"" bestätigen.") 

	' If nothing gets selected then we're done	
	If oStartFace Is Nothing Then Exit While
	
	
	'wenn STRG gedrückt wird, sollen bereits selektierte Flächen wieder abgewählt werden
	If System.Windows.Forms.Control.ModifierKeys = System.Windows.Forms.Keys.Control Then 'STRG wird gedrückt beim Selektieren
		If FaceCol.Count>0 Then
			For k = 1 To FaceCol.Count
				oFace= FaceCol.Item(k)
				If oFace.InternalName = oStartFace.InternalName And oFace.TransientKey = oStartFace.TransientKey Then
					bNEW = False
					Exit For
				End If
			Next
			
		End If
		If bNEW = False
			FaceCol.Remove(k)
			oFace.Appearance = ColorCol.Item(k)
			ColorCol.Remove(k)
			'oHSet.Remove(oFace)
			oApp.ActiveView.Update
		End If
	Else 'STRG wird nicht gedrückt beim selektieren
		If FaceCol.Count>0 Then
			For k = 1 To FaceCol.Count
				oFace= FaceCol.Item(k)
				If oFace.InternalName = oStartFace.InternalName And oFace.TransientKey = oStartFace.TransientKey Then
					bNEW = False
					Exit For
				End If
			Next
		End If
		If bNEW = True Then
			FaceCol.Add(oStartFace)
			ColorCol.Add(oStartFace.Appearance)
			oStartFace.Appearance = oHighlightColor
			'oHSet.AddItem(oStartFace)
			oApp.ActiveView.Update
		End If
	End If
	
	oStartFace = Nothing

End While


'Berechenen der Flächeninhalte der Selektion
Dim i As Integer
If FaceCol.Count > 0 Then
	For i = 1 To FaceCol.Count
		oFace = FaceCol.Item(i)
		AreaCache = AreaCache + oFace.Evaluator.Area
	Next
End If


If AreaCache = 0 Then Return

'Ausgabe Flächeninhalt
AreaCache = Math.Round(AreaCache * 100, 1)

InputBox("Oberfläche:", "Oberflaeche_berechnen_Multiselect", AreaCache & "mm²")

'MessageBox.Show(AreaCache & "mm²")

For i = 1 To FaceCol.Count
	oFace = FaceCol.Item(i)
	oFace.Appearance = ColorCol.Item(i)
	oApp.ActiveView.Update
Next

'oCompDef.ClearAppearanceOverrides() 'Alle farbig veränderten Flächen werden auf Standard gesetzt
oHSet.Clear
FaceCol.Clear
ColorCol.Clear
AreaCache = 0

'End If

'if done, go to the start
GoTo TheStart