11-08-2023
03:05 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
11-08-2023
03:05 AM
here is a working rule,
Thanks to accept solution :
Sub main Dim _inv As Inventor.Application = ThisApplication Dim PartDoc As PartDocument = ThisDoc.Document Dim oTG As TransientObjects = _inv.TransientObjects Dim oDocAssets As Assets = PartDoc.Assets Dim oAppearanceHighlightRed As Asset = GetOrCreateAsset(oDocAssets, "New HighlightRed") Dim ColorHighlightRed As ColorAssetValue = oAppearanceHighlightRed.Item("generic_diffuse") ColorHighlightRed.Value = oTG.CreateColor(255, 0, 0) ' red Dim oStartFace As Face Dim FaceList As New List(Of Face) While True oStartFace = _inv.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 If FaceList.Count = 0 Then FaceList.Add(oStartFace) 'if crtl is pressed and listCount =0, we see crtl press as user fault, dont look oStartFace.Appearance = oAppearanceHighlightRed ElseIf Not FaceList.Contains(oStartFace) Then If Not System.Windows.Forms.Control.ModifierKeys = System.Windows.Forms.Keys.Control Then FaceList.Add(oStartFace) oStartFace.Appearance = oAppearanceHighlightRed End If Else 'contains If System.Windows.Forms.Control.ModifierKeys = System.Windows.Forms.Keys.Control Then FaceList.Remove(oStartFace) oStartFace.AppearanceSourceType = AppearanceSourceTypeEnum.kBodyAppearance End If End If End While If FaceList.Count =0 Then Exit Sub 'Area calculation Dim AreaCache As Double = 0 For Each oFace As Face In FaceList AreaCache = AreaCache + oFace.Evaluator.Area Next If Not AreaCache = o Then AreaCache = Math.Round(AreaCache*100,1) MsgBox("Area : " & AreaCache & "mm²") End If 'reset highligt For Each oFace As Face In FaceList oFace.AppearanceSourceType = AppearanceSourceTypeEnum.kBodyAppearance 'other options to reset easy : kComponentOccurrenceAppearance,kDefaultAppearance,kFeatureAppearance,kMaterialAppearance,kPartAppearance Next End Sub Function GetOrCreateAsset(ByVal assets As Assets, ByVal assetName As String) As Asset Try Return assets.Item(assetName) Catch ex As Exception ' Het asset bestaat nog niet, dus maken we er een aan Return assets.Add(AssetTypeEnum.kAssetTypeAppearance, "Generic", "HighlightRed", assetName) End Try End Function