My first try at VBA, sometimes its really slow....

[Anonymous]

I won't take a lot of credit for this code as its just pieced together from other codes found here on the forum...

Sometimes its working really slow, can it be made shorter or faster in any way? I dont have a clue of what Im doing, but the code works... 🙂

And one other thing is it possible to get it to create flat pattern so i dont have to?

some of the text is in Norwegian...

Sub LaserTimeCalc()

Dim oApp As Inventor.Application
Dim oDoc As Inventor.Document
Set oApp = GetObject(, "Inventor.Application")
If oApp.ActiveDocumentType = kDrawingDocumentObject Then
Set oDoc = oApp.ActiveDocument
Else: If TypeOf oApp.ActiveEditObject Is Sketch Then Exit Sub
Set oDoc = oApp.ActiveEditObject
End If

Dim oSMDef As SheetMetalComponentDefinition
Set oSMDef = oDoc.ComponentDefinition

    'if flatpattern doesnt exist
    If oSMDef.FlatPattern Is Nothing Then
        MsgBox "Create Flatt Pattern First."
        Exit Sub
    End If

Dim oFace As Face
Set oFace = oSMDef.FlatPattern.TopFace

Dim Laser As Double
TotalLength = 0

Dim oEdge As Edge
For Each oEdge In oFace.Edges
Dim oEvaluator As CurveEvaluator
Set oEvaluator = oEdge.Evaluator

Dim minparam As Double
Dim maxparam As Double
Call oEvaluator.GetParamExtents(minparam, maxparam)

Dim length As Double
Call oEvaluator.GetLengthAtParam(minparam, maxparam, length)

Laser = Laser + length

Next


Dim oCustomPropSet As PropertySet

Set oCustomPropSet = oDoc.PropertySets.Item("User Defined Properties")

' Check to see if the property already exists.
On Error Resume Next
Dim oCustomProp As Property
Set oCustomProp = oCustomPropSet.Item("LaserTid")
If Err Then
' It doesn't exist, so create it.
Set oCustomProp = oCustomPropSet.Add(Laser, "LaserTid")
End If

'Factor for cutting time calculation by thickness
 Select Case oSMDef.thickness.Value
 Case 0.02 To 0.25
 Laserparam = 0.000041666
 Case 0.26 To 0.35
 Laserparam = 0.000048333
 Case 0.36 To 0.45
 Laserparam = 0.000051666
 Case 0.46 To 0.55
 Laserparam = 0.0000616666
 Case 0.56 To 0.75
 Laserparam = 0.000075
 Case 0.76 To 0.95
 Laserparam = 0.000091666
 Case 0.96 To 1.15
 Laserparam = 0.00011
 Case 1.16 To 1.35
 Laserparam = 0.000166666
 Case 1.35 To 2
 Laserparam = 0.000216666
 
 End Select

' Set the value. "1.5" is compensating for lead/in out and positioning time. Result is in 1.0 hours
oCustomProp.Value = Format((Laser * Laserparam) * 1.5, "0.0000")

'Show result
MsgBox "Skjæretid for " & oSMDef.thickness.Value & " cm plate" & vbNewLine & "LaserLengde: " & Format(Laser, "0.00") & " cm" & vbNewLine & "LaserTid: " & Format((Laser * Laserparam) * 1.5, "0.0000")

End Sub

[TerryWen]

you can use this statement

Call oSMDef.Unfold

to replace

MsgBox "Create Flatt Pattern First."
Exit Sub

[Anonymous]

Thanks! 🙂