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.
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!
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.
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
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
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