Accessing features from a part in an assembly

[BennyDS]

Hi

I'm crating a macro wich would allow me to select multiple parts in an assembly and then calculate the length of each part. The parts are tubes wich are made of a sinlge sweep.

I started from the example truesweeplength, and built from there.

Now my problem is accessing the sweepfeature from the assembly.

In the part enviroment i use this:

Dim oDoc As PartDocument
Dim oDef As PartComponentDefinition
Dim osweepcount As Long  

Set oDoc = ThisApplication.ActiveDocument

Set oDef = oDoc.ComponentDefinition

osweepcount = oDef.Features.SweepFeatures.Count

The sweepcount is simply to check how many sweep features are in the part.

This works fine in part level.

Now from assembly level I first create an obecjtcollection from all the parts I selected

Set oOccurrences = ThisApplication.TransientObjects.CreateObjectCollection

Then I try to acces the first occurence

oDoc.SelectSet.Item(1)

But then I'm stuck. I cant find the way to acess the features of the selected part.

Thanks for any help.

[jdkriek]

Here's how I'd go about it 😉

Public Sub SeekSweep()
'J.Kriek 2012
    Dim oAssy As AssemblyDocument
    Set oAssy = ThisApplication.ActiveDocument
    Dim invOcc As ComponentOccurrence
    Dim oDef As PartComponentDefinition
    Dim oSweep As SweepFeature
    Dim oSweeps As SweepFeatures
    Dim oSweepCount As Integer

        'Find all parts
        For Each invOcc In oAssy.ComponentDefinition.Occurrences
            If invOcc.DefinitionDocumentType = kPartDocumentObject Then
                Set oDef = invOcc.Definition
                Set oSweeps = oDef.Features.SweepFeatures
                
                    'Find all sweeps
                    For Each oSweep In oSweeps
                        oSweepCount = oDef.Features.SweepFeatures.count
                        Debug.Print oSweep.Name & " from " & invOcc.Name
                    Next
            End If
        Next invOcc
    Debug.Print oSweepCount & " Sweeps Total"
End Sub

Somewhere in the middle of that I have code to calculate the true length of each sweep and output it to user parameters that can easily be extracted to the Assy or Drawing. Hope that helps!

[BennyDS]

Well it looks similar like I did, but i did not use Dim oSweep As SweepFeature and Dim oSweeps As SweepFeatures

I tried to do it in 1 go, so maybe thats my error. I'm not a programmer, so my macros are mostly starting from an example and work my way through it. So sometimes I get stuck and it takes me while to figure it out.

I'll try it out, let you know if it works.

Thank you for the feedback.

[BennyDS]

Hi again.

Thank you for your explaniton,  I got it working.

But now I got another bigger problem.

This is my macro for part level:

Sub underconstruction4() 'select sweep feature


   Dim oDoc As PartDocument
   Set oDoc = ThisApplication.ActiveDocument

   Dim oDef As PartComponentDefinition
   Set oDef = oDoc.ComponentDefinition

   ' Get the first thread feature
   Dim osweep As SweepFeature
   Dim osweepcount As Long
   Dim sweepcounter As Long
   Dim osweepname As String
   Dim totallength As Double
    totallength = 0
   
   osweepcount = oDef.Features.SweepFeatures.Count
   sweepcounter = 0
    
   Do Until sweepcounter = osweepcount
   sweepcounter = sweepcounter + 1
   Set osweep = oDef.Features.SweepFeatures.Item(sweepcounter)
 
 ' Get the centroid of the sweep profile in sketch space
    Dim oProfileOrigin As Point2d
    Set oProfileOrigin = osweep.Profile.RegionProperties.Centroid
    
    ' Transform the centroid from sketch space to model space
    Dim oProfileOrigin3D As Point
    Set oProfileOrigin3D = osweep.Profile.Parent.SketchToModelSpace(oProfileOrigin)
    
    ' Get the set of curves that represent the true path of the sweep
    Dim oCurves As ObjectsEnumerator
    Set oCurves = oDef.Features.SweepFeatures.GetTruePath(osweep.path, oProfileOrigin3D)
    
    Dim Length2 As Double
    Length2 = 0
    
    
    Dim oCurve As Object
    For Each oCurve In oCurves
        
        Dim oCurveEval As CurveEvaluator
        Set oCurveEval = oCurve.Evaluator
        
        Dim MinParam As Double
        Dim MaxParam As Double
        Dim Length As Double
        
        Call oCurveEval.GetParamExtents(MinParam, MaxParam)
        Call oCurveEval.GetLengthAtParam(MinParam, MaxParam, Length)
      '  MsgBox (Length)
        
        Length2 = Length2 + Length
        
        
    Next
    totallength = totallength + Length2
   
    ' Display total sweep length
    'MsgBox "Total sweep length = " & ThisApplication.UnitsOfMeasure.GetStringFromValue(Length2, kMillimeterLengthUnits)

 Loop
MsgBox "combination = " & ThisApplication.UnitsOfMeasure.GetStringFromValue(totallength, kMillimeterLengthUnits)
End Sub

It comes from the samples in inventor itself, mostly.

Now the problem is it works fine for a sweep with a 3D sketch witj straight lines int. But when bends are used in the sketch it starts calculatig it wrong. for example if you have 2 straight lines of 100 mm the result will be 200 mm in total. But when you but a fillet in between the lines with a radius 30 the result is 247 mm. So it counts the lines as still being 100mm.

Any solutions for this?

Thank you

[jdkriek]

This will give you the correct length output to parameter "SweepLength(# of sweep)", if it doesn't see the parameter it will create it for you. I use this in a part with 100s of sweeps, but you can take the calculation for your purposes. You can also look at the immediate window for the debug.print output

Public Sub SweepLength()
'J.Kriek 2012
    Dim oApp As Application
    Set oApp = ThisApplication
    Dim oPart As PartDocument
    Set oPart = oApp.ActiveDocument
    Dim oDef As PartComponentDefinition
    Set oDef = oPart.ComponentDefinition
    Dim oSweep As SweepFeature
    Dim oSweeps As SweepFeatures
    Dim i As Integer
    i = 0
    Set oSweeps = oDef.Features.SweepFeatures
        For Each oSweep In oSweeps
            i = i + 1
            Dim oPaths As Path
            Set oPaths = oSweep.Path
            Dim TotalLength As Double
            TotalLength = 0
            Dim oPathEnt As PathEntity
                For Each oPathEnt In oPaths
                    Dim oCurveEval As CurveEvaluator
                    Set oCurveEval = oPathEnt.Curve.Evaluator
                    Dim MinParam As Double
                    Dim MaxParam As Double
                    Dim Length As Double
                    Call oCurveEval.GetParamExtents(MinParam, MaxParam)
                    Call oCurveEval.GetLengthAtParam(MinParam, MaxParam, Length)
                    TotalLength = TotalLength + Length
                    Dim TotalLengthInches As String
                    Dim TotalLengthFeet As String
                    TotalLengthInches = oApp.UnitsOfMeasure.GetStringFromValue(TotalLength, _
                    UnitsTypeEnum.kInchLengthUnits)
                    TotalLengthFeet = oApp.UnitsOfMeasure.GetStringFromValue(TotalLength, _
                    UnitsTypeEnum.kFootLengthUnits)
                Next
            Dim oparams As Parameters
            Dim oparam As Parameter
            Set oparams = oPart.ComponentDefinition.Parameters
            Dim exists As Boolean
            exists = False
            Dim SweepOutput As String
            SweepOutput = "SweepLength" & i & " = " & _
            TotalLengthInches & " |OR| " & TotalLengthFeet
            Dim SweepNum As String
            SweepNum = "SweepLength" & i
            Debug.Print SweepOutput
                For Each oparam In oparams
                    If oparam.Name = SweepNum Then exists = True
                Next oparam
            If exists Then
                oparams.Item(SweepNum).Value = TotalLength
            Else
                Dim oParameter As Object
                Set oParameter = oparams.UserParameters.AddByValue(SweepNum, TotalLength, _
                UnitsTypeEnum.kInchLengthUnits)
            End If
        Next oSweep
End Sub

 

[BennyDS]

Hi

Again thank you for the feedback, I got it working now.

But...

It is rounding the figure.

For instance if the total length of all sweeps is 3111.5 mm it rounds it to 3110.0 mm

Any ideas why it does this?

Its not realy that important to me because I do not need to know it with that accuracy, but I would like to know why it does that 🙂

here is my code, still a work in progress.

To make it work select a part in an assembly with a sweep in it.

Public Sub underconstruction5()
    
    Dim oDoc As Document
   ' Dim opropset As Document
   ' Dim odoctype As DocumentTypeEnum
    'Dim oAssemblydoc As AssemblyDocument
   
    Dim gewichttotaal As Single
    Dim oOcc As ComponentOccurrence
    Dim gewichttest As String
    Dim oOccurrences As ObjectCollection
    Dim counter As Integer
    
    Dim oSweep As SweepFeatures
    Dim osweep2 As SweepFeature
    Dim osweepcount As Long
    Dim sweepcounter As Long
    Dim osweepname As String
    Dim TotalLength As Double
    Dim oPart As PartComponentDefinition
 
     
    TotalLength = 0
    counter = 0

   Set oDoc = ThisApplication.ActiveDocument
   
Set oOccurrences = ThisApplication.TransientObjects.CreateObjectCollection ' make a collection of selected parts
For Each oOcc In oDoc.SelectSet
    oOccurrences.Add oOcc
Next
    
For Each oOcc In oOccurrences
    
    Dim totalsweep As Long
    totalsweep = 0
      counter = (counter + 1)
        sweepcounter = 0
        Set oPart = oDoc.SelectSet.Item(counter).Definition
        Set oSweep = oPart.Features.SweepFeatures
             Dim onrsweeps As SweepFeature
             For Each onrsweeps In oSweep
                sweepcounter = sweepcounter + 1
            
                Set osweep2 = oPart.Features.SweepFeatures.Item(sweepcounter)
                Dim opaths As path
                
                Set opaths = osweep2.path
                Dim oPathEnt As PathEntity
                
                For Each oPathEnt In opaths
                    Dim oCurveEval As CurveEvaluator
                    Set oCurveEval = oPathEnt.Curve.Evaluator
                    Dim MinParam As Double
                    Dim MaxParam As Double
                    Dim Length As Double
                    Call oCurveEval.GetParamExtents(MinParam, MaxParam)
                    Call oCurveEval.GetLengthAtParam(MinParam, MaxParam, Length)
                    TotalLength = TotalLength + Length
                Next
           Next
        Dim totalparts As Long
         Dim msgtotal As String
    
         totalsweep = totalsweep + TotalLength
   
       msgtotal = msgtotal & vbCrLf & ThisApplication.UnitsOfMeasure.GetStringFromValue(totalsweep, kMillimeterLengthUnits)
       totalparts = totalparts + TotalLength
       TotalLength = 0
Next
 
    MsgBox "Individual lengths: " & vbCrLf & msgtotal & vbCrLf & vbCrLf & "combination all parts: " & vbCrLf & vbCrLf & ThisApplication.UnitsOfMeasure.GetStringFromValue(totalparts, kMillimeterLengthUnits)

Set MyData = New DataObject  ' copy total length to clipboard
    MyData.SetText ThisApplication.UnitsOfMeasure.GetStringFromValue(totalparts, kMillimeterLengthUnits) 'gewichttotaal
    MyData.PutInClipboard

End Sub

[jdkriek]

Glad I could help you again

Precision is from UnitsOfMeasure.GetStringFromValue