Finding perimeter length of sheet metal flat pattern including cutouts

[gary.belisle]

I'm trying to write a VB.Net program (Visual Studio 2010 Express) for Inventor 2012 that will add up the length of all the edges of a flat pattern including any cutouts/holes in the part. I need the total length to do an estimate on the amount of time required to cut out the pattern on a laser. Any ideas how to get this info programatically in VB?

[gary.belisle]

I found a solution to this here....

http://forums.autodesk.com/t5/Autodesk-Inventor-Customization/Sheet-Metal-Flatpattern-Info/td-p/1765...

I redid it a little thought...

    Private Sub GetTotalLength(ByVal oDoc As PartDocument, ByVal enumUnits As UnitsTypeEnum)

        If Not oDoc.DocumentSubType.DocumentSubTypeID = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
            MessageBox.Show("Convert part file to sheet metal and retry...", "Part Not Sheet Metal", MessageBoxButtons.OK)
            Exit Sub
        End If

        Dim oSMDef As SheetMetalComponentDefinition
        oSMDef = oDoc.ComponentDefinition

        If Not oSMDef.HasFlatPattern Then
            MessageBox.Show("Create flat pattern and retry...", "Missing Flat Pattern", MessageBoxButtons.OK)
            Exit Sub
        End If

        Dim suffix As String = ""
        Dim strFormat As String = "N3"

        Select Case enumUnits
            Case UnitsTypeEnum.kInchLengthUnits
                suffix = "in"
                strFormat = "N3"
            Case UnitsTypeEnum.kMillimeterLengthUnits
                suffix = "mm"
                strFormat = "N2"
            Case UnitsTypeEnum.kFootLengthUnits
                suffix = "ft"
                strFormat = "N3"
            Case UnitsTypeEnum.kMeterLengthUnits
                suffix = "m"
                strFormat = "N2"
        End Select

        Dim oTopFace As Face = oSMDef.FlatPattern.TopFace
        Dim oBotFace As Face = oSMDef.FlatPattern.BottomFace

        Dim FlatWidth As Double = oDoc.UnitsOfMeasure.ConvertUnits(oSMDef.FlatPattern.Width, _
                                                                   UnitsTypeEnum.kDatabaseLengthUnits, _
                                                                   enumUnits)

        Dim FlatLength As Double = oDoc.UnitsOfMeasure.ConvertUnits(oSMDef.FlatPattern.Length, _
                                                                   UnitsTypeEnum.kDatabaseLengthUnits, _
                                                                   enumUnits)

        Dim TotalLengthTopInches As Double = GetPerimeterLengthOfFace(oDoc, oTopFace, enumUnits)

        Dim TotalLengthBotInches As Double = GetPerimeterLengthOfFace(oDoc, oBotFace, enumUnits)

        Dim CutLength As Double
        Dim EtchLength As Double


        If TotalLengthTopInches > TotalLengthBotInches Then
            CutLength = TotalLengthBotInches
            EtchLength = TotalLengthTopInches - TotalLengthBotInches
        Else
            CutLength = TotalLengthTopInches
            EtchLength = TotalLengthBotInches - TotalLengthTopInches
        End If


        MessageBox.Show("Total Cut  length: " & CutLength.ToString(strFormat) & " " & suffix & vbNewLine & _
               "Total Etch length: " & EtchLength.ToString(strFormat) & " " & suffix & vbNewLine & _
               "Width : " & FlatWidth.ToString(strFormat) & " " & suffix & vbNewLine & _
               "Length: " & FlatLength.ToString(strFormat) & " " & suffix, _
               "Cut and Etch lengths", _
               MessageBoxButtons.OK)

    End Sub

    Private Function GetPerimeterLengthOfFace(ByVal oDoc As Document, _
                                              ByVal oFace As Face, _
                                              ByVal enumUnits As UnitsTypeEnum) As Double

        Dim TotalLength As Double
        TotalLength = 0

        For Each oEdge As Edge In oFace.Edges

            Dim oEvaluator As CurveEvaluator
            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)

            TotalLength = TotalLength + length
        Next

        Dim TotalLengthByEnumUnits As Double
        TotalLengthByEnumUnits = oDoc.UnitsOfMeasure.ConvertUnits(TotalLength, UnitsTypeEnum.kDatabaseLengthUnits, enumUnits)

        Return TotalLengthByEnumUnits

    End Function

[BLHDrafting]

Here is a macro I use to make 4 custom iProperties, InternalPerimiters, ExternalPerimeter, TotalPerimiter (sum of the 2 previous) and Pierces (all internal loops+1 for external).

Sub GetIntExtPerimeters()

    Dim oPartDoc As Document
    Set oPartDoc = ThisApplication.ActiveDocument
    Dim oFlatPattern As FlatPattern

    ' Check for a non-part document
    If oPartDoc.DocumentType <> kPartDocumentObject Then
        MsgBox "The Active document must be a 'Part'!"
        Exit Sub
    End If

    ' The Active document must be a Sheet metal Part
    If oPartDoc.SubType <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
        MsgBox "The 'Part' must be a Sheet Metal Part!"
        Exit Sub
    End If
       
    ' Check to see if the flat pattern exists.
    Set oFlatPattern = oPartDoc.ComponentDefinition.FlatPattern
    If oFlatPattern Is Nothing Then
        MsgBox "No flat pattern exists for this part!"
        Exit Sub
    End If
    
    Dim oSheetMetalCompDef As SheetMetalComponentDefinition
    Set oSheetMetalCompDef = oPartDoc.ComponentDefinition

    ' Get the cut length
    Dim oFace As Face
    Set oFace = oSheetMetalCompDef.FlatPattern.TopFace

    ' Find the outer loop.
    Dim dOuterLength As Double
    dOuterLength = 0
    Dim oLoop As EdgeLoop
    For Each oLoop In oFace.EdgeLoops
        If oLoop.IsOuterEdgeLoop Then
            Dim oEdge As Edge
            For Each oEdge In oLoop.Edges
                ' Get the length of the current edge.
                Dim dMin As Double, dMax As Double
                Call oEdge.Evaluator.GetParamExtents(dMin, dMax)
                Dim dLength As Double
                Call oEdge.Evaluator.GetLengthAtParam(dMin, dMax, dLength)
                dOuterLength = dOuterLength + dLength
            Next
            'MsgBox "Outer Loop is " & FormatNumber(dOuterLength, 1)
            Exit For
        End If
    Next

    ' Iterate through the inner loops.
    Dim iLoopCount As Long
    iLoopCount = 0
    Dim dTotalLength As Double
    For Each oLoop In oFace.EdgeLoops
        Dim dLoopLength As Double
        dLoopLength = 0
        If Not oLoop.IsOuterEdgeLoop Then
            For Each oEdge In oLoop.Edges
                ' Get the length of the current edge.
                Call oEdge.Evaluator.GetParamExtents(dMin, dMax)
                Call oEdge.Evaluator.GetLengthAtParam(dMin, dMax, dLength)
                dLoopLength = dLoopLength + dLength
            Next

            ' Add this loop to the total length.
            dTotalLength = dTotalLength + dLoopLength
            'MsgBox "Inner Loops are " & FormatNumber(dTotalLength, 1)
        End If
    Next
    
'added by BH 13-07-2011-count edges to calculate peirces
Dim oDoc As PartDocument
Set oDoc = ThisApplication.ActiveDocument

Dim oDef As SheetMetalComponentDefinition
Set oDef = oDoc.ComponentDefinition

Set oFlatPattern = oDef.FlatPattern

Dim oTransaction As Transaction
Set oTransaction = ThisApplication.TransactionManager.StartTransaction(oDoc, "FindArea ")

Dim oSketch As PlanarSketch
Set oSketch = oFlatPattern.Sketches.Add(oFlatPattern.TopFace)

Dim oEdgeLoop As EdgeLoop

numLoops = 1
For Each oEdgeLoop In oFlatPattern.TopFace.EdgeLoops
    If oEdgeLoop.IsOuterEdgeLoop = False Then
        numLoops = numLoops + 1
    End If
Next

TotalPierces = numLoops

For Each oEdgeLoop In oFlatPattern.TopFace.EdgeLoops
    If oEdgeLoop.IsOuterEdgeLoop Then
        Exit For
    End If
Next

For Each oEdge In oEdgeLoop.Edges
    Call oSketch.AddByProjectingEntity(oEdge)
Next

Dim oProfile As Profile
Set oProfile = oSketch.Profiles.AddForSolid

oTransaction.Abort
'end

    Dim oUom As UnitsOfMeasure
    Set oUom = oPartDoc.UnitsOfMeasure
    outerCutlength = oUom.GetStringFromValue(dOuterLength, kMillimeterLengthUnits)
    innerCutlength = oUom.GetStringFromValue(dTotalLength, kMillimeterLengthUnits)
    TotalCutLength = oUom.GetStringFromValue(dTotalLength + dOuterLength, kMillimeterLengthUnits)
    
    'Write data to properties, creating or updating (if property exists)
    Dim oCustomPropSet As PropertySet
    Set oCustomPropSet = oPartDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")

    On Error Resume Next
    oCustomPropSet.Item("OuterPerimeter").Value = outerCutlength
    If Err Then
        Err.Clear
        Call oCustomPropSet.Add(outerCutlength, "OuterPerimeter")
    End If
    oCustomPropSet.Item("InnerPerimeters").Value = innerCutlength
    If Err Then
        Err.Clear
        Call oCustomPropSet.Add(innerCutlength, "InnerPerimeters")
    End If
    oCustomPropSet.Item("TotalPerimeter").Value = TotalCutLength
    If Err Then
        Err.Clear
        Call oCustomPropSet.Add(TotalCutLength, "TotalPerimeter")
    End If
    
    'added by BH 13-07-2011
    oCustomPropSet.Item("Pierces").Value = TotalPierces
    If Err Then
        Err.Clear
        Call oCustomPropSet.Add(TotalPierces, "Pierces")
    End If
    End
    
End Sub

[leblanc2024]

Hello BLHDrafting,

Do you have a version of this code that works with Inventor 2014?

Regrads,

Ivon

[nmunro]

Brendan,

What happens if the flat pattern includes punches that do not "cut" through the material, i.e. Dimples, louvers, etc. They seem to be included in the inner length calculation.

Neil

[brendan.henderson]

Ivon, I'm still on 2013 so I don't know how it goes on 2014. I'm assuming that yu have tried it an it failed. I think there are a few 'reference' that need to be turned on for this to work. I'm on holiday now (4 day weekend) so I won't be able to look at it till Tuesday. I'll post something then.

[brendan.henderson]

Neil, I have not used Punches so I don't know. I guess you have tried the code with punches and have seen that they are included in the perimeter values, which is probably not correct depending on your requirements.

I didn't write the code. A colleague from the UK did and I think he has passed on. Someone who knows about this stuff should be able to filter (exclude) these from the perimeter results, and probably be able to create a Punches number if that is part of what they need.

The code works perfectly for my needs. Any full thickness protrusion add's to the inner perimeter count.

[leblanc2024]

Hello Brendan,

I restarted inventor and it works fine.  I didn't think a restart would have been required.

Thanks,

Ivon

[Anonymous]

Hi

did you manage to get this to work in 2014 version?

I have tried and kept getting errors even after I rebooted

Regards

Mark

[leblanc2024]

Hello Mark,

When using VBA Editor in Inventor I copied a version of the macro into the ApplicatioProject (Default.ivb).

Once the file is located in default.ivb location it works for all files.

Once this is done I made a short cut by customizing my toolbar.  To automate the process I created a iLogc rule to call up the macro....

Here is the iLogic rule...

InventorVb.RunMacro("ApplicationProject", "sheetmetal3", "GetIntExtPerimeters")

I added this to the event triggers...

I hope this helps.

[Anonymous]

Hi Ivon

Thanks I was getting a bit worried when I tried to run the debug it came up with errors, I had also pre entered the custome properties which I think may not have helped but it looks to be working now

Regards

Mark

[Anonymous]

hello friend, ı applied your code and ı get some error. Can you help me to solve my issues pls.

after ı run program ı get a warning "All other sub's or function's must be after Sub Main ()

why do ı get this warning?

[leblanc2024]

Hello Brendan,

I tried to call this macro from a differnt macro to automate the part information and had trouble.  I took a long time to debug.

    'added by BH 13-07-2011
    oCustomPropSet.Item("Pierces").Value = TotalPierces
    If Err Then
        Err.Clear
        Call oCustomPropSet.Add(TotalPierces, "Pierces")
    End If
    End
    
End Sub

I commented out the end prior to the end sub.  This seemed to work.

'added by BH 13-07-2011
    oCustomPropSet.Item("Pierces").Value = TotalPierces
    If Err Then
        Err.Clear
        Call oCustomPropSet.Add(TotalPierces, "Pierces")
    End If

    'End 'This end causes the macros to stop any further action.
    
End Sub

I hope this helps.

[Anonymous]

Hi Brendan, 

Is there any simple way to modify a snipped given below to make it useful as direct iLogic code? 

outerCutlength = oUom.GetStringFromValue(dOuterLength, kMillimeterLengthUnits)
innerCutlength = oUom.GetStringFromValue(dTotalLength, kMillimeterLengthUnits)
TotalCutLength = oUom.GetStringFromValue(dTotalLength + dOuterLength, kMillimeterLengthUnits)

I try to rewrite Your macro to direct iLogic code. As result I get perimeters in "cm". I'd like to change units to "mm"

Thanks in advance for help 

Tomek

[Anonymous]

I've handeled somehow with the rule for laser cutting time calculation. Now I'd like to edit the rule to have one single rule working both for a single file and an assembly. Below You can find the rule  Ive prepared.  Works fine for a single sheet metal file. The problem is when it starts  with the assembly. I looks like the rule  is not able to read the the parameter thickness of  a sheet metal part within the assembly. Mayby somebody will be able to repair it.

Sub Main Czas_Palenia_Laser ()

  Dim oFile As Document
  oFile = ThisDoc.Document

    If oFile.DocumentType = kPartDocumentObject Then
	Call Part(oFile)
	End If
	
	If oFile.DocumentType = kAssemblyDocumentObject Then
	Call Assy(oFile)
	End If

End Sub

Sub Assy (oDoc As Document)

'oDoc = ThisApplication.ActiveDocument
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument		'Zmiany 12.07.2019
oCompDef = oAsmDoc.ComponentDefinition

Dim oRefDocs As DocumentsEnumerator 
oRefDocs = oDoc.AllReferencedDocuments 
Dim oRefDoc As Document 

For Each oRefDoc In oRefDocs 
	
        If oRefDoc.DocumentType = kPartDocumentObject Then 
		
				If oRefDoc.IsModifiable = True Then 'Wyklucza elementy należące do biblioteki części m.in. śruby, nakrętki itp.
								
						If oRefDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then    'Sprawdza czy część wchodząca w skład złożenia została utworzona z wykorzystaniem szablonu konstrukcja blachowa.
							
							ThisApplication.Documents.Open(oRefDoc.FullFileName, True)
							Call Part(oRefDoc)
							oRefDoc.Close
							
						Else
						End If
			
				Else
				End If
        
        End If
		
 Next

End Sub

Sub Part (oDoc As Document)

 	'oDoc = ThisApplication.ActiveDocument
	
	Dim oSMDef As SheetMetalComponentDefinition	
	oSMDef = oDoc.ComponentDefinition
		
	If oSMDef.HasFlatPattern = False Then
	   oSMDef.Unfold
	   oSMDef.FlatPattern.ExitEdit
   	End If
	
	Dim oFlatPattern As FlatPattern
	oFlatPattern = oDoc.ComponentDefinition.FlatPattern

    Dim oFace As Face
    oFace = oSMDef.FlatPattern.TopFace

    Dim oOuterLength As Integer
    oOuterLength = 0
	
    Dim oLoop As EdgeLoop
	Dim dMax, dMin, dLength As Double
	Dim oEdge As Edge
	
    For Each oLoop In oFace.EdgeLoops
        If oLoop.IsOuterEdgeLoop Then
            
            For Each oEdge In oLoop.Edges
                Call oEdge.Evaluator.GetParamExtents(dMin, dMax)
                Call oEdge.Evaluator.GetLengthAtParam(dMin, dMax, dLength)
               
				oOuterLength = oOuterLength + dLength
				
            Next
            Exit For
        End If
    Next
	
	'--> MessageBox.Show(oOuterLength, "iLogic Test Value No1")
	Dim iLoopCount As Long
	iLoopCount = 0
	Dim oInnerLength,oLoopLength As Double

    For Each oLoop In oFace.EdgeLoops

        oLoopLength = 0
        If Not oLoop.IsOuterEdgeLoop Then
            For Each oEdge In oLoop.Edges
                Call oEdge.Evaluator.GetParamExtents(dMin, dMax)
                Call oEdge.Evaluator.GetLengthAtParam(dMin, dMax, dLength)
                oLoopLength = oLoopLength + dLength
            Next

            oInnerLength = oInnerLength + oLoopLength		'Oblicza całkowitą dł. pętli (sumę obowdów) wew. detalu.	

        End If
    Next

	'--> MessageBox.Show(oTotalLength, "iLogic Test Value No2")
	Dim oTransaction As Transaction
	oTransaction = ThisApplication.TransactionManager.StartTransaction(oDoc, "FindArea ")

	Dim oSketch As PlanarSketch
	oSketch = oFlatPattern.Sketches.Add(oFlatPattern.TopFace)

	Dim oEdgeLoop As EdgeLoop

numLoops = 1
For Each oEdgeLoop In oFlatPattern.TopFace.EdgeLoops
    If oEdgeLoop.IsOuterEdgeLoop = False Then
        numLoops = numLoops + 1
    End If
Next

Dim NoPierces As Double
NoPierces = numLoops   'WPALENIA !!!!
'--> MessageBox.Show(NoPierces, "iLogic Test Value No3")

For Each oEdgeLoop In oFlatPattern.TopFace.EdgeLoops
    If oEdgeLoop.IsOuterEdgeLoop Then
        Exit For
    End If
Next

For Each oEdge In oEdgeLoop.Edges
    Call oSketch.AddByProjectingEntity(oEdge)
Next

	Dim oProfile As Profile
	
	oProfile = oSketch.Profiles.AddForSolid
	oTransaction.Abort
	
'-------------------------------------------------------------------------------------------------------------
'Konwersja zmiennych tak by możliwe było zapisanie wartości parametrów jako niestandardowe wartości iLogic
	
    Dim oUom As UnitsOfMeasure
	Dim oLengthUnits As String
    
	oUom = oDoc.UnitsOfMeasure
	oLengthUnits = oUom.GetStringFromType(oUom.LengthUnits)
	
    OuterCutLength = oUom.GetStringFromValue(oOuterLength, oLengthUnits)
	InnerCutlength = oUom.GetStringFromValue(oInnerLength, oLengthUnits)
    TotalCutLength = oUom.GetStringFromValue(oInnerLength + oOuterLength, oLengthUnits)
	'--> MessageBox.Show(OuterCutLength & " " & InnerCutlength & " " & TotalCutLength , "iLogic Test Value No4")

'-------------------------------------------------------------------------------------------------------------
'Zapisywanie parametrów jako niestandardowe wartości iLogic

    Dim oCustomPropSet As PropertySet
    oCustomPropSet = oDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
	
	Try
	oCustomPropSet.Add(OuterCutLength, "Dł. zew. krawędzi")
	Catch
	iProperties.Value ("Custom","Dł. zew. krawędzi") = OuterCutLength
	End Try
	
	Try
	oCustomPropSet.Add(InnerCutLength, "Dł. wew. krawędzi")
	Catch
	iProperties.Value ("Custom","Dł. wew. krawędzi") = InnerCutLength
	End Try
	
	Try
	oCustomPropSet.Add(TotalCutLength, "Całk. dł. krawędzi")
	Catch
	iProperties.Value ("Custom","Całk. dł. krawędzi") = TotalCutLength
	End Try
	
	Try
	oCustomPropSet.Add(CStr(NoPierces), "Ilość wpaleń")
	Catch
	iProperties.Value ("Custom","Ilość wpaleń") = CStr(NoPierces)
	End Try

'---------------------------------------------------------------------------------------------------------------------
'Wybór materiału

oMaterialArray = New String(){"STAL", "STAL NIERDZEWNA", "STAL GALWANIZOWANA", "ALUMINIUM"}
oMaterial = InputListBox("Z powyższej listy wybierz rodzaj materiału z którego wykonany jest detal",oMaterialArray, "Stal", "iLogic", "Wybierz rodzaj materiału")

'---------------------------------------------------------------------------------------------------------------------
'Dobór wartości posuwu głowicy

Dim FeedRate, Thickness As Double

	Try
	Thickness = oDoc.ComponentDefinition.Parameters("Grubość")							'Pobiera parametr grubość przypisany do konstrukcji blachowej
	Catch
	Thickness = oDoc.ComponentDefinition.Parameters("Thickness")	
	End Try
	
		'If Thickness Is Nothing Then
		'MessageBox.Show("Wystąpił problem z pobraniem parametru grubość z modelu", "iLogic")
		'Exit Sub
		'End If
	
	Try
	MaterialName = oDoc.ComponentDefinition.Material.Name			'Pobiera dane dot. materiału przypisanego do modelu.
	Catch
	MessageBox.Show("Wystąpił problem z pobraniem danych dot. materiału przypisanego do modelu", "iLogic")
	End Try

	If oMaterial = "STAL" Then
	
		Select Case Thickness
			Case 1
			FeedRate = 5500					'8300	
			Case 1.4 To 1.6
			FeedRate = 4500					'6500
			Case 2.5
			FeedRate = 4000
			Case 2
			FeedRate = 3500					'6000
			Case 2.9 To 3.1
			FeedRate = 2000					'3500
			Case 4
			FeedRate = 2500					'3500
			Case 4.9 To 5.1
			FeedRate = 2000					'2700
			Case 5.9 To 6.1
			FeedRate = 1900					'2400
			Case 8
			FeedRate = 1200					'1900
			Case 10
			FeedRate = 1100                '1400
			Case 11.9 To 12.1
			FeedRate = 1000                '1100
			Case 15
			FeedRate = 800                 '950
			Case 16
			FeedRate = 700
			Case 20
			FeedRate = 650                 '650
		
		End Select
	Else
	End If
	
	If oMaterial = "STAL NIERDZEWNA" Then 
	
		Select Case Thickness
			Case 1: FeedRate = 5000                 '9000
			Case 1.4 To 1.6 
			FeedRate = 4200
			Case 2: FeedRate = 2500					'6100
			Case 2.9 To 3.1
			FeedRate = 1800                 		'3800
			Case 4: FeedRate = 1800					'2500
			Case 5: FeedRate = 1600					'2000
			Case 5.9 To 6.1 
			FeedRate = 1400
			Case 8: FeedRate = 1000                 '800
			Case 10: FeedRate = 800					'650
			Case 12: FeedRate = 800					'270
		
		End Select
	Else
	End If
	
	If oMaterial = "STAL GALWANIZOWANA" Then 
		
		Select Case Thickness
			Case 1: FeedRate = 5500 			    '9000
			Case 1.25: FeedRate = 5000              '6500
			Case 1.4 To 1.55
			FeedRate = 4500              			'7500
			Case 2: FeedRate = 3500                 '6000
			Case 2.9 To 3.1
			FeedRate = 2000                 	    '3000
		
		End Select
	Else
	End If
	
	If oMaterial = "ALUMINIUM" Then
		
		Select Case Thickness
			Case 1: FeedRate = 5500 		        '9000
			Case 1.5: FeedRate = 4700               '7300
			Case 2: FeedRate = 4000                 '5800
			Case 2.5: FeedRate = 3900               '4300
			Case 2.9 To 3.1 
			FeedRate = 2300                 '2900
			Case 4: FeedRate = 1900                 '2400
			Case 5: FeedRate = 1600                 '1800
			Case 6: FeedRate = 1500                 '1400
			Case 8: FeedRate = 1000					'750
		
			End Select
	Else
	End If

			If FeedRate = 0 Then
			MessageBox.Show("Wystąpił problem z doborem prędkości posuwu głowicy!" _
			& vbLf _
			& vbLf & "Materiał przypisany do modelu: " & MaterialName _
			& vbLf _
			& vbLf & "Grubość materiału: " & Thickness & " mm" _
			& vbLf _
			& vbLf & "Wybrana wartość posuwu: " & FeedRate & " [mm/min]" _
			& vbLf _
			& vbLf & "Sprawdź ustawienia materiału przypiasanego do modelu i uruchom regułę ponownie", "iLogic")
			Exit Sub
			End If
			
			'-->MessageBox.Show(FeedRate, "iLogic")
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------
' OBLICZENIA

Dim totalPierces As Double

PierceDeclar = MessageBox.Show ("Czy chcesz zdefiniować ilość wpaleń danego typu: puls/normalne?" _
& vbLf & " " _
& vbLf & "Wybierz TAK aby zdefiniować ilości wpaleń danego typu." _
& vbLf & " " _
& vbLf & "Wybierz NIE - wszystkie występujące wpalenia zostaną uwzględnione jako normalne" _
& vbLf & " " _
& vbLf & "Wpalenia typu puls znajdują zastosowanie w przypadku gdy śr. otworu jest mniejsza lub równa od grubości palonego materiału", "iLogic", MessageBoxButtons.YesNo, MessageBoxIcon.Information, MessageBoxDefaultButton.Button2)

	If PierceDeclar = vbYes Then
	
		Do
			nPierces = InputBox("Podaj ilość wpaleń normalne:" _
			& vbLf _
			& vbLf & "Wszystkie wpalenia: " & NoPierces,"iLogic", 0)
			
			pPierces = InputBox("Podaj ilość wpaleń puls:" _
			& vbLf _
			& vbLf & "Wszystkie wpalenia: " & NoPierces _
			& vbLf _
			& vbLf & "Wpalenia normalne: " & nPierces,"iLogic", 0)
			
				If nPierces = "" Then
				Exit Sub
				End If
	
		pPierces_value = CDbl(pPierces) 'Function to convert string value into a double
		nPierces_value = CDbl(nPierces) 
		
		totalPierces = nPierces_value + pPierces_value
	
				If totalPierces <> NoPierces Then
		
					MessageBox.Show("Zadeklarowano niewłaściwą ilość wpaleń!" _
					& vbLf _
					& vbLf & "Podaj prawidłową sumaryczną ilość wpaleń", "iLogic")
					
				End If
	
		Loop Until totalPierces = NoPierces  'Pętla wymusza na użytkowniku podanie prawidłowej ilości wpaleń, co ogranicza ryzyko błędu
		'Return
	
	Else
	nPierces_value = CDbl(NoPierces)
	End If

Dim EdgeCutTime As Double

	If oInnerLength = 0 Then 
	   EdgeCutTime = ((oOuterLength*10) / FeedRate)     'Przypadek gdy detal ma tylko obrys zewnętrzny, mnożnik x10 dodano aby przeliczyć jednostki cm -> mm
	
	Else
		
		Dim PerimeterFactor As Double 
		PerimeterFactor = Math.Round((oOuterLength / oInnerLength), 2, MidpointRounding.AwayFromZero)	'Współczynnik opisujący stosunek obwodu zewnętrzengo do wewnętrznego.
		
			Select Case PerimeterFactor
		
			Case <=2.5:			EdgeCutTime = ((((oInnerLength + oOuterLength)*10) / FeedRate)*PerimeterFactor)
								'MessageBox.Show("Case 1", "iLogic")
			Case 2.5 To 3.5:	EdgeCutTime = ((((oInnerLength + oOuterLength)*10)/ FeedRate)*(PerimeterFactor/2.5))
								'MessageBox.Show("Case 2", "iLogic")							
			Case 3.5 To 5.5:	EdgeCutTime = ((((oInnerLength + oOuterLength)*10) / FeedRate)*(PerimeterFactor/3.5))
								'MessageBox.Show("Case 3", "iLogic")					
			Case Else:			EdgeCutTime = (((oInnerLength + oOuterLength)*10) / FeedRate)
								'MessageBox.Show("Case 4", "iLogic")
			End Select
	End If

Dim CutTime, WynikIFS As Double
'MessageBox.Show(EdgeCutTime, "iLogic")
CutTime = EdgeCutTime + ((nPierces_value * 0.025) + (pPierces_value * 0.055))

Dim Wynik As String
Wynik = Math.Round(CutTime,2, MidpointRounding.AwayFromZero).ToString("0.00")
WynikIFS = Math.Round((Wynik * 0.0167),3,MidpointRounding.AwayFromZero)

'-------------------------------------------------------------------------------------------
' PREZENTACJA WYNIKÓW							

		MessageBox.Show("Gatunek blachy: " & MaterialName _
		&vbLf _
		&vbLf & "Grubość blachy: " & Thickness & " mm." _
		&vbLf _
		&vbLf & "Ilość wpaleń: " & nPierces_value _
		&vbLf _
		&vbLf & "Prędkość posuwu: " & FeedRate & " mm/min." _
		&vbLf _
		&vbLf & "Czas palenia Laser: " & Wynik & " min." & " (" & WynikIFS & ") ", "iLogic")
		
		'&vbLf & "Współczynnik: " & PerimeterFactor _										'Wyświetla wartość współczynnika.
		'&vbLf _
		

	Try
	oCustomPropSet.Add(WynikIFS, "Czas palenia")
	Catch
	iProperties.Value("Custom","Czas palenia") = WynikIFS
	End Try
	
	RuleParametersOutput()
    InventorVb.DocumentUpdate()

End Sub

Thanks in advance for help.

Tomek

[de_wet]

This works well for me.
Is there any way of firing this macro from Assembly level in the background? If I change the dimensions of an assembly by means of ilogic/form, the rule will state that the "document needs to be a part" and not update the custom iproperties. Only when you have re-flattened your flat pattern will the iproperties update. Any advice?

[de_wet]

This works well for me.
Is there any way of firing this macro from Assembly level in the background? If I change the dimensions of an assembly by means of ilogic/form, the rule will state that the "document needs to be a part" and not update the custom iproperties. Only when you have re-flattened your flat pattern will the iproperties update. Any advice?