CAD tip # 13039:

Pomocí následujícího iLogic předpisu můžete v Inventoru zobrazit údaje o složitosti 3D modelu (součásti, dílu, .IPT) - je vypsán počet, celková délka a maximální délka hrany, plus počet, celková plocha a maximální plocha (výměra) povrchů ploch součásti, počet konstrukčních prvků a počet děr i děr se závitem (včetně případných polí/vzorů).

Nejsou zahrnuty délky eliptických a spline hran, nezpracování vypnutí prvků polí. Jednotky výpisu můžete určit na 3. řádku.

'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

Alternativní metoda:

Alternativním způsobem zjištění složitosti dílu, fungujícím i na importované modely bez inteligence, je spočtení řádků popisujících 3D geometrii daného dílu ve STEP souboru. Pro tento účel můžete použít následující iLogic předpis:

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