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: 18731

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    24810×  
Prices - CAD eShop:
applies to: Inventor ·

See also:
Tip 13965:Total length of sweeps in Inventor - wires, pipes, trusses, tubes, hoses (iLogic)
Tip 13920:Saving your Inventor model in the presentation color scheme (iLogic).
Tip 13884:How to send e-mails with an iLogic macro?
Tip 13836:How to reset view numbering in Inventor?
Tip 13744:Simple password protection of Inventor documents (iLogic).


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:
Extend your AutoCAD LT productivity with our popular add-on
CADstudio LT Extension More info


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