Over 1.095.000 registered users (EN+CZ).
AutoCAD tips, Inventor tips, Revit tips.
Try the new precise Engineering calculator.
New AutoCAD 2026 commands and variables.
CAD tip # 13040:
Question
A
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
Inventor


19.8.2021
38318×
applies to: Inventor ·