CAD Forum - tips, tricks, discussion and utilities for AutoCAD, Inventor, Revit and other Autodesk products [www.cadforum.cz]
CZ | EN | DE
Login or
registration
  Visitors: 2983

CAD tip CAD tip # 13040:

   
Question CAD 
 %  platform  category 
Q - question

iLogic - display information about complexity of an Inventor part.

A - answer

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
100% *  CAD 
19.8.2021    563×  
applies to: Inventor ·

See also:
Tip 12828:How to quickly delete 3rd party links to external objects in Inventor?
Tip 12644:How to identify parts and assemblies imported from STEP/IGES?
Tip 12520:How to set Inventor Display style and Lighting style from an iLogic macro?
Tip 12508:How to assign an expression (not value) to a user parameter with iLogic?
Tip 12451:How to fill a material or appearance name into part's iProperties?


Back   All CAD Tips



Have we helped you? If you want to support the CAD Forum web service, consider buying one of our CAD applications, or our custom software development offerings, or donating via PayPal (see above). You may also add a link to your web - like this "fan" link: CAD Forum - tips, utilities, blocks for Autodesk products
CAD:    OS:    Categ: 
Text:  FAQ glossary   



Featuring:
Link your AutoCAD block attributes with Excel tables/sheets. Automatically. Dynamically. Bidirectionally.
Try Excellink 2015 More info


Please use these tips at your own risk.
CAD Studio is not responsible for possible problems that may occur as a result of using any of these tips.
TOPlist