With the following iLogic rule you can show data about complexity of a 3D model (part, .IPT) in Inventor - it will list the count, total length and maximum length of part edges, the count, total area and maximum area of part faces, number of features, number of holes and tapped holes (threads), incl. any patterns.
Doesn't process elliptic and spline edges nor pattern suppression. You can preset display units on the 3rd line.
'Get part complexity - www.cadforum.cz
Sub Main
Dim Units As String = "mm" ' units to display
Dim oPDoc As PartDocument = ThisDoc.Document
Dim oFaceAreas As List(Of Double) = GetAllFaceAreas(oPDoc,Units)
Dim oEdgeLengths As List(Of Double) = GetAllEdgeLengths(oPDoc, Units)
Dim HolesC, THolesC As Double
Call GetHoles(oPDoc, HolesC, THolesC)
Dim oFacesTotalArea As Double = oFaceAreas.Sum
Dim oEdgesTotalLenth As Double = oEdgeLengths.Sum
oFaceAreas.Sort 'smallest first
Dim oMaxFaceArea As Double = oFaceAreas.Last
Dim oFaceCount As Integer = oFaceAreas.Count
MsgBox("Faces Count = " & oFaceCount & vbCrLf & _
"Max Face Area = " & oMaxFaceArea & " " & Units & "²" & vbCrLf & _
"Total Faces Area = " & oFacesTotalArea & " " & Units & "²", , "FACES")
'a = InputListBox("", oFaceAreas,"", "FACE AREAS", "FACE AREAS LIST")
oEdgeLengths.Sort 'smallest first
Dim oMaxEdgeLength As Double = oEdgeLengths.Last
Dim oEdgeCount As Integer = oEdgeLengths.Count
MsgBox("Edges Count = " & oEdgeCount & vbCrLf & _
"Max Edge Length = " & oMaxEdgeLength & " " & Units & vbCrLf & _
"Total Edges Length = " & oEdgesTotalLenth & " " & Units, , "EDGES")
'a = InputListBox("", oEdgeLengths, "", "EDGE LENGTHS", "EDGE LENGTHS LIST")
MsgBox("Total features = " & oPDoc.ComponentDefinition.Features.Count & vbCrLf & _
"Chamfer features = " & oPDoc.ComponentDefinition.Features.ChamferFeatures.Count & vbCrLf & _
"Fillet features = " & oPDoc.ComponentDefinition.Features.FilletFeatures.Count & vbCrLf & _
"Thread features = " & oPDoc.ComponentDefinition.Features.ThreadFeatures.Count & vbCrLf & _
"Modeled holes (total) = " & HolesC & vbCrLf & _
"Tapped holes = " & THolesC & vbCrLf , , "FEATURES + HOLES")
End Sub
Function GetAllFaceAreas(oPartDoc As PartDocument, Units As String) As List(Of Double)
Dim oUOM As UnitsOfMeasure = oPartDoc.UnitsOfMeasure
Dim oAreas As New List(Of Double)
For Each oBody As SurfaceBody In oPartDoc.ComponentDefinition.SurfaceBodies
For Each oFace As Face In oBody.Faces
oAreas.Add(oUOM.ConvertUnits(oFace.Evaluator.Area, "cm cm", Units & " " & Units))
Next
Next
Return oAreas
End Function
Function GetAllEdgeLengths(oPartDoc As PartDocument, Units As String) As List(Of Double)
Dim wasElliptic As Boolean = False
Dim oLengths As New List(Of Double)
Dim oUOM As UnitsOfMeasure = oPartDoc.UnitsOfMeasure
For Each oBody As SurfaceBody In oPartDoc.ComponentDefinition.SurfaceBodies
For Each oEdge As Edge In oBody.Edges
Dim oLength As Double
Select Case oEdge.GeometryType
Case CurveTypeEnum.kLineCurve, kLineSegmentCurve, kPolylineCurve
oEdge.Evaluator.GetLengthAtParam(0.0, 1.0, oLength)
Case kCircularArcCurve
Dim oArc As Arc3d = oEdge.Geometry
Dim oRadius As Double = oUOM.ConvertUnits(oArc.Radius, "cm", Units)
oLength = (oRadius * oArc.SweepAngle) 'arc length
Case kCircleCurve
Dim oCircle As Circle = oEdge.Geometry
Dim oRadius As Double = oUOM.ConvertUnits(oCircle.Radius, "cm", Units)
oLength = (2 * Math.PI * oRadius) 'Circumference
Case kEllipseFullCurve, kEllipticalArcCurve, kBSplineCurve ' !!!
'Dim oEllipse As EllipseFull
'Dim oEArc As EllipticalArc
'Dim oBS As BSplineCurve
'not processing complex curves !!!
wasElliptic = True
End Select
oLengths.Add(oLength)
Next
Next
Return oLengths
End Function
Function GetHoles (oPartDoc As PartDocument, ByRef CountHole As Double, ByRef CountTHole As Double)
Dim oApp As Application = ThisApplication
Dim oFeats = oPartDoc.ComponentDefinition.Features
Dim ObjCol1 As ObjectCollection = oApp.TransientObjects.CreateObjectCollection
Dim ObjCol2 As ObjectCollection = oApp.TransientObjects.CreateObjectCollection
Dim oParentFeat As PartFeature
Dim oHoleInPat As HoleFeature
Dim oRecPat As RectangularPatternFeature
Dim oCirPat As CircularPatternFeature
For Each oRecPat In oFeats.RectangularPatternFeatures
oParentFeat = oRecPat.ParentFeatures.Item(1)
If oParentFeat.Type = ObjectTypeEnum.kHoleFeatureObject Then
oHoleInPat = oParentFeat
Call ObjCol2.Add(oRecPat)
If oHoleInPat.Tapped Then Call ObjCol1.Add(oRecPat)
End If
Next
For Each oCirPat In oFeats.CircularPatternFeatures
oParentFeat = oCirPat.ParentFeatures.Item(1)
If oParentFeat.Type = ObjectTypeEnum.kHoleFeatureObject Then
oHoleInPat = oParentFeat
Call ObjCol2.Add(oCirPat)
If oHoleInPat.Tapped Then Call ObjCol1.Add(oCirPat)
End If
Next
For Each oHole In oFeats.HoleFeatures
ObjCol2.Add(oHole)
If oHole.Tapped Then Call ObjCol1.Add(oHole)
Next
Call GetCount(ObjCol1, CountTHole)
Call GetCount(ObjCol2, CountHole)
End Function
'all indiv holes (except patt.control)
Sub GetCount(ByVal ObjCol1 As ObjectCollection, ByRef CountHole As Double)
For i = 1 To ObjCol1.Count
On Error Resume Next
If ObjCol1.Item(i).Type = ObjectTypeEnum.kHoleFeatureObject Then
For Each itemrec In ObjCol1
If itemrec.Type = ObjectTypeEnum.kRectangularPatternFeatureObject _
Or itemrec.Type = ObjectTypeEnum.kCircularPatternFeatureObject Then
If ObjCol1.Item(i).Name = itemrec.ParentFeatures.Item(1).Name Then
Call ObjCol1.Remove(i)
End If
End If
Next
End If
Next
CountHole = 0
For Each Item In ObjCol1 ' count, incl. patterns
If Item.Type = ObjectTypeEnum.kRectangularPatternFeatureObject _
Or Item.Type = ObjectTypeEnum.kCircularPatternFeatureObject Then
CountHole = CountHole + Item.PatternElements.Count
ElseIf Item.Type = ObjectTypeEnum.kHoleFeatureObject Then
CountHole = CountHole + 1
End If
Next
End Sub
Alternative method:
An alternative way to determine the complexity of a part, which works even on imported dumb models without intelligence, is to calculate the number of lines describing 3D geometry of the part in its STEP file. For this purpose you can use the following iLogic rule:
Sub Main
Dim oSTEPTranslator As TranslatorAddIn
oSTEPTranslator = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
Dim oContext As TranslationContext
oContext = ThisApplication.TransientObjects.CreateTranslationContext
Dim oOptions As NameValueMap
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
If oSTEPTranslator.HasSaveCopyAsOptions(ThisApplication.ActiveDocument, oContext, oOptions) Then
oOptions.Value("ApplicationProtocolType") = 3
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
Dim oData As DataMedium
oData = ThisApplication.TransientObjects.CreateDataMedium
oData.FileName = "C:\TEMP\Complexity.stp" ' or ThisDoc.PathAndFileName(False)
oSTEPTranslator.SaveCopyAs(ThisApplication.ActiveDocument, oContext, oOptions, oData)
MsgBox("Complexity/Lines: " & cntLines(oData.FileName), , "Complexity")
My.Computer.FileSystem.DeleteFile(oData.FileName)
End If
End Sub
Function cntLines(fName As String) As Integer
dim oFile As Object
oFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(fName, 8, True)
cntLines = oFile.Line
oFile.Close()
End Function