CadPaste

Inventor · iLogic · 2 days ago

Calculating the price of sheet materials

Макрос для расчета цены листовых материалов в зависимости от размера заготовки, длины реза, количества гибов. Makros dlya rascheta tseny listovykh materialov v zavisimosti ot razmera zagotovki, dliny reza, kolichestva gibov. 109 A macro for calculating the price of sheet materials based on the dimensions of the workpiece, the length of the cut, and the number of bends.

How to use it


The macro contains a list of configuration variables that affect the price and the report:

  • CfgDecimalPlaces — number of decimal places for values ​​in the report
  • CfgMaterialAllowanceMm — allowance on each side of the workpiece (mm); blank size = flat pattern dimensions + 2 × allowance
  • CfgPricePerBend — cost per bend
  • CfgPricePerMmBendLineEngraver — cost for marking 1 mm of a bend line
  • CfgPricePerMmCutPer1MmThickness — laser cutting cost per 1 mm of cut length for a material thickness of 1 mm
  • CfgMaterialPrice — material cost (unit — see below)
  • CfgMaterialPricePerKg — unit for material cost: True = per kg, False = per m²
  • CfgMaterialNet — area used for material calculation: True = area after cutting, False = area of ​​the bounding rectangle from which the part is cut
  • CfgExportTxt — saves the report as a .txt file in the same location as the part file
iLogic
'==============================================================================
' ObliczeniaBlach.iLogicVb - Autodesk Inventor iLogic rule (single file)
' Analog of SheetMetalCalc.bas (SolidWorks) / Preliminary Cost Estimate panel.
'
' WHAT THIS RULE DOES
'   For the active sheet-metal Part:
'     - reads part name / thickness / material / weight
'     - ensures FlatPattern (Unfold if missing)
'     - measures area, blank (+ allowance), laser path, bend count / length
'     - computes material / cut / bend / engraver / total price
'   Shows a text report (MsgBox) and optionally saves .txt next to the model:
'     {name}_{material}_{thickness}_{yyyy-MM-dd_HH-mm-ss}.txt
'
' HOW TO USE
'   1) Edit SETTINGS (Cfg* Functions below) - prices, allowance, TXT, notify.
'   2) Inventor: External Rules -> Add Rule -> select this .iLogicVb
'      (prefer local disk, not W:\ / OneDrive - same tip as Save.iLogicVb).
'   3) Open a SAVED sheet-metal Part, run the rule.
'
' CONFIG (Cfg*) - change Return values only:
'   CfgDecimalPlaces, CfgMaterialAllowanceMm, CfgPricePerBend,
'   CfgPricePerMmBendLineEngraver, CfgPricePerMmCutPer1MmThickness,
'   CfgMaterialPrice, CfgMaterialPricePerKg, CfgMaterialNet,
'   CfgExportTxt, CfgNotify
'
' RETURN / REPORT
'   BuildReport() always returns text. Empty / error lines mean calculation failed.
'   Settings block is appended so a TXT export can restore inputs later.
'
' NOTES FOR BEGINNERS
'   - iLogic = VB.NET (not VBA). Sub Main must come first.
'   - Do NOT put Dim / Const / Shared above Main - iLogic will not compile.
'     Settings are Functions that Return a value (same idea as VBA Const / Save.iLogicVb).
'   - ThisApplication is given by iLogic.
'   - Inventor database length = cm -> mm via *10; area cm2 -> mm2 via *100.
'   - Use "mm2" (ASCII), not Unicode superscript - safer in MsgBox / TXT.
'==============================================================================

'===== ENTRY ==================================================================

Sub Main()
    ' ok: True when we produced a usable report (and optional TXT write succeeded)
    Dim report As String = ""
    Dim path As String = ""
    Dim ok As Boolean = True

    Try
        Dim oDoc As Document = ThisApplication.ActiveDocument
        If oDoc Is Nothing Then
            MsgBox("No document open.", MsgBoxStyle.Exclamation, "SheetMetalCalc")
            Return
        End If

        report = BuildReport(oDoc)
        ' Heuristic: short "not a sheet part" / empty is still a report, but mark fail for icon
        ok = (report.Length > 0) AndAlso _
             (report.IndexOf("No document", StringComparison.OrdinalIgnoreCase) < 0) AndAlso _
             (report.IndexOf("not a sheet part", StringComparison.OrdinalIgnoreCase) < 0)

        ' Optional TXT next to the model (needs FullFileName)
        If CfgExportTxt() AndAlso ok AndAlso HasSavedPath(oDoc) Then
            path = BuildTxtPath(oDoc)
            If path.Length > 0 Then
                If WriteTextFile(path, report) Then
                    report = report & vbCrLf & ModuleSep() & vbCrLf & _
                             PadKey("export") & " - " & path
                Else
                    report = report & vbCrLf & ModuleSep() & vbCrLf & _
                             "Export failed: could not write TXT."
                    ok = False
                End If
            End If
        End If

        If CfgNotify() = 1 OrElse Not ok Then
            Dim icon As MsgBoxStyle = If(ok, MsgBoxStyle.Information, MsgBoxStyle.Exclamation)
            MsgBox(report, icon, "SheetMetalCalc")
        End If
    Catch ex As Exception
        MsgBox("SheetMetalCalc error: " & ex.Message, MsgBoxStyle.Critical, "SheetMetalCalc")
    End Try
End Sub

'----- SETTINGS (edit Return values) ------------------------------------------
' *** EDIT ONLY THIS BLOCK to configure prices / allowance / export ***
' Same meaning as the SW panel / SheetMetalCalc.bas inputs.
' Change the Return value, then save the rule and run again.
' Implemented as Functions: iLogic forbids module-level Const/fields
' (same pattern as Save.iLogicVb CfgExportPdf / CfgNotify / ...).

Function CfgDecimalPlaces() As Integer
    ' How many digits after the decimal in report numbers (area, blank, prices, ...).
    ' Example: 2 -> "12.50"; 0 -> "13".
    Return 2
End Function

Function CfgMaterialAllowanceMm() As Double
    ' Extra stock on EACH side of the blank (mm).
    ' Blank size = flat Length/Width + 2 * allowance (both sides).
    ' Example: 1.0 -> +1 mm left and +1 mm right (same for height).
    Return 1.0
End Function

Function CfgPricePerBend() As Double
    ' Money charged PER bend (bend count from flat-pattern bend edges).
    ' Bending price = bendCount * CfgPricePerBend.
    Return 2.0
End Function

Function CfgPricePerMmBendLineEngraver() As Double
    ' Money per mm of bend CENTERLINE (engraver / marking along the bend).
    ' Engraver price = totalBendLengthMm * this rate.
    Return 0.1
End Function

Function CfgPricePerMmCutPer1MmThickness() As Double
    ' Laser cutting rate.
    ' Cutting price = laserPathLengthMm * thicknessMm * this rate.
    ' (Longer cut and thicker sheet = higher price.)
    Return 13.55
End Function

Function CfgMaterialPrice() As Double
    ' Material unit price. Unit depends on CfgMaterialPricePerKg:
    '   True  -> currency per 1 kg
    '   False -> currency per 1 m2
    Return 12.0
End Function

Function CfgMaterialPricePerKg() As Boolean
    ' How to interpret CfgMaterialPrice:
    '   True  = Per 1 kg (uses part mass / estimated blank mass)
    '   False = Per 1 m2 (uses net area or blank area in m2)
    Return True
End Function

Function CfgMaterialNet() As Boolean
    ' Which area drives material quantity:
    '   True  = Area (Net)  - unfolded face area / mass of the part
    '   False = Blank (Gross) - rectangular blank including allowance
    Return False
End Function

Function CfgExportTxt() As Boolean
    ' True  = also save the report as .txt next to the part file
    '         name: {part}_{material}_{thickness}_{yyyy-MM-dd_HH-mm-ss}.txt
    ' False = only MsgBox, no file
    Return True
End Function

Function CfgNotify() As Integer
    ' 0 = show MsgBox only when something failed
    ' 1 = always show the full report MsgBox (default)
    Return 1
End Function

'----- FIXED LABELS (usually do not edit) -------------------------------------
' Layout helpers for the text report - not pricing settings.

Function KeyCol() As Integer
    ' Pad width for short report keys ("part", "thickness", "price", ...).
    Return 12
End Function

Function SettingsKeyCol() As Integer
    ' Pad width for the Settings block keys (longer labels).
    Return 24
End Function

Function ModuleSep() As String
    ' Separator line between report sections ("---").
    Return "---"
End Function

Function UndefLabel() As String
    ' Placeholder when thickness / material / name cannot be read.
    Return "undefined"
End Function

Function SheetMetalSubtype() As String
    ' Inventor Part SubType GUID that marks a sheet-metal part.
    Return "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
End Function

'===== REPORT =================================================================

Function BuildReport(oDoc As Document) As String
    ' Build the full human-readable cost report for one sheet-metal part.
    Dim isSm As Boolean = False
    Dim infoPart As String = UndefLabel()
    Dim infoThk As String = UndefLabel()
    Dim infoMat As String = UndefLabel()
    Dim infoW As String = UndefLabel()
    Dim hasWeight As Boolean = False
    Dim hasThk As Boolean = False
    Dim weightKg As Double = 0
    Dim thkMm As Double = 0
    Dim canMsg As String = ""
    Dim areaMm2 As Double = 0
    Dim blankL As Double = 0
    Dim blankW As Double = 0
    Dim blankA As Double = 0
    Dim laserMm As Double = 0
    Dim bendLenMm As Double = 0
    Dim bendCnt As Integer = 0
    Dim hasArea As Boolean = False
    Dim hasBlank As Boolean = False
    Dim hasLaser As Boolean = False
    Dim hasBendCnt As Boolean = False
    Dim hasBendLen As Boolean = False
    Dim hasOverlap As Boolean = False
    Dim overlapMsg As String = ""
    Dim matCost As Double? = Nothing
    Dim cutCost As Double? = Nothing
    Dim bendCost As Double? = Nothing
    Dim engCost As Double? = Nothing
    Dim totalTxt As String = ""
    Dim modules As String = ""
    Dim sheetBlock As String = ""
    Dim engBlock As String = ""

    GetPartInfo(oDoc, isSm, infoPart, infoThk, infoMat, infoW, hasWeight, weightKg, hasThk, thkMm)

    If Not isSm Then
        Return "Document is not a sheet part." & vbCrLf & _
               "(Open a part with Flat Pattern / sheet metal.)" & _
               vbCrLf & ModuleSep() & vbCrLf & BuildSettingsBlock()
    End If

    If Not CanFlatten(oDoc, canMsg) Then
        Return PartHeader(infoPart, infoThk, infoMat, hasWeight, infoW) & _
               PadKey("price") & " - (not calculated)" & vbCrLf & _
               ModuleSep() & vbCrLf & canMsg & _
               vbCrLf & ModuleSep() & vbCrLf & BuildSettingsBlock()
    End If

    If Not CalcOnFlatPattern(oDoc, areaMm2, hasArea, blankL, blankW, blankA, hasBlank, _
                             laserMm, hasLaser, bendCnt, hasBendCnt, bendLenMm, hasBendLen, _
                             hasOverlap, overlapMsg) Then
        Return PartHeader(infoPart, infoThk, infoMat, hasWeight, infoW) & _
               PadKey("price") & " - (not calculated)" & vbCrLf & _
               ModuleSep() & vbCrLf & _
               "Cannot flatten this part: Flat-Pattern/Flatten operation is unavailable." & _
               vbCrLf & ModuleSep() & vbCrLf & BuildSettingsBlock()
    End If

    If hasOverlap Then
        Return PartHeader(infoPart, infoThk, infoMat, hasWeight, infoW) & _
               PadKey("price") & " - (not calculated)" & vbCrLf & _
               ModuleSep() & vbCrLf & _
               Nz(overlapMsg, "Geometry check found issues in flat pattern.") & _
               vbCrLf & ModuleSep() & vbCrLf & BuildSettingsBlock()
    End If

    ' No bends -> bend length is zero (engraver line not needed)
    If hasBendCnt AndAlso bendCnt <= 0 Then
        bendLenMm = 0
        hasBendLen = True
    End If

    matCost = CalcMaterialCost(hasWeight, weightKg, hasArea, areaMm2, hasBlank, blankA)
    cutCost = CalcCutCost(hasLaser, laserMm, hasThk, thkMm)
    bendCost = CalcBendCost(hasBendCnt, bendCnt)
    engCost = CalcEngraverCost(hasBendLen, bendLenMm)
    totalTxt = FormatTotalPrice(matCost, cutCost, bendCost, engCost)

    modules = PartHeader(infoPart, infoThk, infoMat, hasWeight, infoW) & _
              PadKey("price") & " - " & totalTxt

    ' --- Sheet / laser / bends block ---
    sheetBlock = "Sheet OK" & vbCrLf
    If hasArea Then
        sheetBlock &= PadKey("area") & " - " & FmtNum(areaMm2, CfgDecimalPlaces()) & " mm2" & vbCrLf
    End If
    If hasBlank Then
        sheetBlock &= PadKey("blank") & " - " & _
                      FmtNum(blankL, CfgDecimalPlaces()) & " x " & FmtNum(blankW, CfgDecimalPlaces()) & " mm (" & _
                      FmtNum(blankA, CfgDecimalPlaces()) & " mm2), allowance +" & _
                      FmtNumG(CfgMaterialAllowanceMm()) & " mm per side (from settings)" & vbCrLf
    End If
    sheetBlock &= PadKey("material price") & " - " & FormatMoney(matCost) & vbCrLf
    sheetBlock &= ModuleSep() & vbCrLf & "Laser cut" & vbCrLf
    If hasLaser Then
        sheetBlock &= PadKey("length") & " - " & FmtNum(laserMm, CfgDecimalPlaces()) & " mm" & vbCrLf
        sheetBlock &= PadKey("cutting price") & " - " & FormatMoney(cutCost) & vbCrLf
    Else
        sheetBlock &= PadKey("length") & " - -" & vbCrLf
        sheetBlock &= PadKey("cutting price") & " - (not calculated)" & vbCrLf
    End If
    sheetBlock &= ModuleSep() & vbCrLf & "Bends" & vbCrLf
    sheetBlock &= PadKey("count") & " - " & If(hasBendCnt, bendCnt.ToString(), "0") & vbCrLf
    sheetBlock &= PadKey("bending price") & " - " & FormatMoney(bendCost)
    modules &= vbCrLf & ModuleSep() & vbCrLf & sheetBlock

    ' --- Engraver block (price along bend lines) ---
    engBlock = "Engraver" & vbCrLf
    If hasBendLen Then
        engBlock &= PadKey("length") & " - " & FmtNum(bendLenMm, CfgDecimalPlaces()) & " mm" & vbCrLf
    Else
        engBlock &= PadKey("length") & " - -" & vbCrLf
    End If
    engBlock &= PadKey("rate") & " - " & FmtNumG(CfgPricePerMmBendLineEngraver()) & vbCrLf
    engBlock &= PadKey("price") & " - " & FormatMoney(engCost)
    modules &= vbCrLf & ModuleSep() & vbCrLf & engBlock

    modules &= vbCrLf & ModuleSep() & vbCrLf & BuildSettingsBlock()
    Return modules
End Function

Function PartHeader(partName As String, thk As String, mat As String, _
                    hasWeight As Boolean, weight As String) As String
    ' First lines of every report: part / thickness / material [/ weight].
    Dim s As String = PadKey("part") & " - " & partName & " loaded" & vbCrLf & _
                      PadKey("thickness") & " - " & thk & vbCrLf & _
                      PadKey("material") & " - " & mat & vbCrLf
    If hasWeight Then s &= PadKey("weight") & " - " & weight & vbCrLf
    Return s
End Function

Function BuildSettingsBlock() As String
    ' Appended to every report so TXT export records the inputs that were used.
    Dim s As String = "Settings" & vbCrLf
    s &= PadSettingsKey("decimal places") & " - " & ClampDec(CfgDecimalPlaces()).ToString() & vbCrLf
    s &= PadSettingsKey("material allowance") & " - " & FmtNumG(CfgMaterialAllowanceMm()) & " mm" & vbCrLf
    s &= PadSettingsKey("price per bend") & " - " & FmtNumG(CfgPricePerBend()) & vbCrLf
    s &= PadSettingsKey("price per mm engraver") & " - " & FmtNumG(CfgPricePerMmBendLineEngraver()) & vbCrLf
    s &= PadSettingsKey("price per mm cut") & " - " & FmtNumG(CfgPricePerMmCutPer1MmThickness()) & vbCrLf
    s &= PadSettingsKey("material price") & " - " & FmtNumG(CfgMaterialPrice()) & vbCrLf
    s &= PadSettingsKey("material price unit") & " - " & If(CfgMaterialPricePerKg(), "Per 1 kg", "Per 1 m2") & vbCrLf
    s &= PadSettingsKey("material quantity") & " - " & If(CfgMaterialNet(), "Area", "Blank")
    Return s
End Function

'===== SMALL HELPERS ==========================================================

Function IsBlank(s As String) As Boolean
    Return String.IsNullOrEmpty(s)
End Function

Function Nz(value As String, fallback As String) As String
    If IsBlank(value) Then Return fallback
    Return value
End Function

Function HasSavedPath(oDoc As Document) As Boolean
    ' Unsaved docs have empty FullFileName - cannot write TXT next to model.
    Try
        Return Not IsBlank(oDoc.FullFileName)
    Catch
        Return False
    End Try
End Function

Function PadKey(key As String) As String
    ' Left-align key in a fixed column so the report looks like a table.
    If key.Length >= KeyCol() Then Return key
    Return key & New String(" "c, KeyCol() - key.Length)
End Function

Function PadSettingsKey(key As String) As String
    If key.Length >= SettingsKeyCol() Then Return key
    Return key & New String(" "c, SettingsKeyCol() - key.Length)
End Function

Function FmtNum(v As Double, dec As Integer) As String
    ' Fixed decimal places, invariant culture (dot as decimal separator).
    Return v.ToString("F" & ClampDec(dec).ToString(), System.Globalization.CultureInfo.InvariantCulture)
End Function

Function FmtNumG(v As Double) As String
    ' General format (settings / rates).
    Return v.ToString("G", System.Globalization.CultureInfo.InvariantCulture)
End Function

Function FormatMoney(v As Double?) As String
    ' Nullable Double: Nothing -> "(not calculated)".
    If Not v.HasValue Then Return "(not calculated)"
    Return FmtNum(v.Value, 2)
End Function

Function ClampDec(n As Integer) As Integer
    If n < 0 Then Return 0
    If n > 10 Then Return 10
    Return n
End Function

'===== PART INFO ==============================================================

Sub GetPartInfo(oDoc As Document, ByRef isSm As Boolean, ByRef partName As String, _
                ByRef thickness As String, ByRef material As String, ByRef weight As String, _
                ByRef hasWeight As Boolean, ByRef weightKg As Double, _
                ByRef hasThk As Boolean, ByRef thkMm As Double)
    ' Fill display strings + numeric thickness/weight for pricing.
    isSm = False
    partName = UndefLabel()
    thickness = UndefLabel()
    material = UndefLabel()
    weight = UndefLabel()
    hasWeight = False
    weightKg = 0
    hasThk = False
    thkMm = 0

    Try
        partName = oDoc.DisplayName
        If IsBlank(partName) Then partName = UndefLabel()
    Catch
        partName = UndefLabel()
    End Try

    If Not IsSheetMetalPart(oDoc) Then Return
    isSm = True

    Try
        Dim sm As SheetMetalComponentDefinition = GetSmDef(oDoc)
        thkMm = sm.Thickness.Value * 10.0 ' cm -> mm
        If thkMm > 0 Then
            hasThk = True
            thickness = FmtNum(thkMm, CfgDecimalPlaces()) & " mm"
        End If
    Catch
    End Try

    Try
        Dim pDoc As PartDocument = CType(oDoc, PartDocument)
        Dim mat As Material = pDoc.ActiveMaterial
        If mat IsNot Nothing AndAlso Not String.IsNullOrWhiteSpace(mat.DisplayName) Then
            material = mat.DisplayName
        End If
    Catch
        material = UndefLabel()
    End Try

    ' Mass only if material is known (same rule as SW panel)
    If material <> UndefLabel() Then
        Try
            Dim sm As SheetMetalComponentDefinition = GetSmDef(oDoc)
            Dim mass As Double = sm.MassProperties.Mass
            If mass >= 0 Then
                hasWeight = True
                weightKg = mass
                weight = FmtNum(mass, CfgDecimalPlaces()) & " kg"
            End If
        Catch
            hasWeight = False
        End Try
    End If
End Sub

Function IsSheetMetalPart(oDoc As Document) As Boolean
    Try
        If oDoc.DocumentType <> DocumentTypeEnum.kPartDocumentObject Then Return False
        Dim pDoc As PartDocument = CType(oDoc, PartDocument)
        If String.Equals(pDoc.SubType, SheetMetalSubtype(), StringComparison.OrdinalIgnoreCase) Then Return True
        Return TypeOf pDoc.ComponentDefinition Is SheetMetalComponentDefinition
    Catch
        Return False
    End Try
End Function

Function GetSmDef(oDoc As Document) As SheetMetalComponentDefinition
    ' Call only after IsSheetMetalPart is True.
    Dim pDoc As PartDocument = CType(oDoc, PartDocument)
    Return CType(pDoc.ComponentDefinition, SheetMetalComponentDefinition)
End Function

'===== FLATTEN / GEOMETRY =====================================================

Function CanFlatten(oDoc As Document, ByRef msg As String) As Boolean
    ' Ensure a FlatPattern exists (Unfold if needed). msg explains failure.
    msg = ""
    Try
        If Not IsSheetMetalPart(oDoc) Then
            msg = "Active document is not a part."
            Return False
        End If

        Dim sm As SheetMetalComponentDefinition = GetSmDef(oDoc)
        If Not sm.HasFlatPattern Then
            Try
                sm.Unfold()
            Catch
                msg = "Cannot flatten this part: Flat-Pattern/Flatten operation is unavailable."
                Return False
            End Try
        End If

        If sm.FlatPattern Is Nothing Then
            msg = "Cannot flatten this part: Flat pattern body is unavailable."
            Return False
        End If

        msg = "Flat pattern is available."
        Return True
    Catch
        msg = "Cannot flatten this part: an error occurred while preparing Flat Pattern."
        Return False
    End Try
End Function

Function CalcOnFlatPattern(oDoc As Document, _
                           ByRef areaMm2 As Double, ByRef hasArea As Boolean, _
                           ByRef blankL As Double, ByRef blankW As Double, ByRef blankA As Double, ByRef hasBlank As Boolean, _
                           ByRef laserMm As Double, ByRef hasLaser As Boolean, _
                           ByRef bendCnt As Integer, ByRef hasBendCnt As Boolean, _
                           ByRef bendLenMm As Double, ByRef hasBendLen As Boolean, _
                           ByRef hasOverlap As Boolean, ByRef overlapMsg As String) As Boolean
    ' Measure manufacturing geometry on the flat pattern.
    hasArea = False : hasBlank = False : hasLaser = False
    hasBendCnt = False : hasBendLen = False
    hasOverlap = False
    overlapMsg = ""

    Try
        Dim sm As SheetMetalComponentDefinition = GetSmDef(oDoc)
        If Not sm.HasFlatPattern Then
            Try
                sm.Unfold()
            Catch
                Return False
            End Try
        End If

        Dim fp As FlatPattern = sm.FlatPattern
        If fp Is Nothing Then Return False

        ' Inventor has no Body.Check2 like the SW panel - skip overlap, treat as OK
        hasOverlap = False
        overlapMsg = "Geometry check skipped (Inventor)."

        ' Area: TopFace evaluator returns cm2 -> mm2 (*100)
        Try
            Dim areaCm2 As Double = fp.TopFace.Evaluator.Area
            If areaCm2 > 0 Then
                areaMm2 = areaCm2 * 100.0
                hasArea = True
            End If
        Catch
        End Try

        ' Blank: FlatPattern Length/Width (cm->*10) + allowance per side
        Try
            Dim lenMm As Double = fp.Length * 10.0
            Dim widMm As Double = fp.Width * 10.0
            Dim allow As Double = CfgMaterialAllowanceMm()
            If lenMm >= widMm Then
                blankL = lenMm + 2.0 * allow
                blankW = widMm + 2.0 * allow
            Else
                blankL = widMm + 2.0 * allow
                blankW = lenMm + 2.0 * allow
            End If
            blankA = blankL * blankW
            hasBlank = True
        Catch
        End Try

        ' Laser path: sum of all TopFace edge-loop lengths (outer + holes), cm -> mm
        Try
            Dim totalCm As Double = 0
            Dim mt As MeasureTools = ThisApplication.MeasureTools
            Dim lp As EdgeLoop
            For Each lp In fp.TopFace.EdgeLoops
                totalCm += mt.GetLoopLength(lp)
            Next
            If totalCm > 0 Then
                laserMm = totalCm * 10.0
                hasLaser = True
            End If
        Catch
        End Try

        ' Bends: unique bend edges on top face (up + down), grouped if colinear
        Dim bc As Integer = 0
        Dim blMm As Double = 0
        GetBendMetrics(fp, bc, blMm)
        bendCnt = bc
        bendLenMm = blMm
        hasBendCnt = True
        hasBendLen = True

        Return True
    Catch
        Return False
    End Try
End Function

Sub GetBendMetrics(fp As FlatPattern, ByRef bendCount As Integer, ByRef bendLengthMm As Double)
    ' Count bends and total bend-line length on the flat pattern.
    ' Preferred: kBendUp / kBendDown edges, merge colinear connected pieces.
    ' Fallback: FlatBendResults (divide by 2 because top+bottom duplicates).
    bendCount = 0
    bendLengthMm = 0
    Try
        Dim edges As New List(Of Edge)
        Try
            Dim up As Edges = fp.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendUpFlatPatternEdge, True)
            Dim e As Edge
            For Each e In up
                edges.Add(e)
            Next
        Catch
        End Try
        Try
            Dim down As Edges = fp.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendDownFlatPatternEdge, True)
            Dim e2 As Edge
            For Each e2 In down
                edges.Add(e2)
            Next
        Catch
        End Try

        If edges.Count = 0 Then
            Try
                Dim res As FlatBendResults = fp.FlatBendResults
                If res IsNot Nothing AndAlso res.Count > 0 Then
                    bendCount = CInt(Math.Ceiling(res.Count / 2.0))
                    Dim totalCm As Double = 0
                    Dim i As Integer
                    For i = 1 To res.Count
                        Try
                            If Not res.Item(i).IsOnBottomFace Then
                                totalCm += EdgeLengthCm(res.Item(i).Edge)
                            End If
                        Catch
                        End Try
                    Next
                    bendLengthMm = totalCm * 10.0
                End If
            Catch
            End Try
            Return
        End If

        ' Precompute length / endpoints / direction for each bend edge
        Dim n As Integer = edges.Count
        Dim visited(n - 1) As Boolean
        Dim lens(n - 1) As Double
        Dim p1(n - 1) As Point
        Dim p2(n - 1) As Point
        Dim dir(n - 1) As UnitVector
        Dim tg As TransientGeometry = ThisApplication.TransientGeometry
        Dim iEdge As Integer

        For iEdge = 0 To n - 1
            lens(iEdge) = EdgeLengthCm(edges(iEdge))
            Try
                p1(iEdge) = edges(iEdge).StartVertex.Point
                p2(iEdge) = edges(iEdge).StopVertex.Point
                Dim vx As Double = p2(iEdge).X - p1(iEdge).X
                Dim vy As Double = p2(iEdge).Y - p1(iEdge).Y
                Dim vz As Double = p2(iEdge).Z - p1(iEdge).Z
                Dim len As Double = Math.Sqrt(vx * vx + vy * vy + vz * vz)
                If len > 0.0000001 Then
                    dir(iEdge) = tg.CreateUnitVector(vx / len, vy / len, vz / len)
                Else
                    dir(iEdge) = Nothing
                End If
            Catch
                dir(iEdge) = Nothing
            End Try
        Next

        ' BFS: connect edges that share an endpoint and are nearly parallel
        Dim groups As Integer = 0
        Dim totalLenCm As Double = 0
        Dim tol As Double = 0.0001
        Dim cosTol As Double = 0.9999

        For iEdge = 0 To n - 1
            If visited(iEdge) OrElse dir(iEdge) Is Nothing Then Continue For
            groups += 1
            Dim q As New Queue(Of Integer)
            visited(iEdge) = True
            q.Enqueue(iEdge)
            Dim groupLen As Double = 0

            Do While q.Count > 0
                Dim j As Integer = q.Dequeue()
                groupLen += lens(j)
                Dim k As Integer
                For k = 0 To n - 1
                    If visited(k) OrElse dir(k) Is Nothing Then Continue For
                    If Not ShareEndpointPts(p1(j), p2(j), p1(k), p2(k), tol) Then Continue For
                    Dim dot As Double = dir(j).X * dir(k).X + dir(j).Y * dir(k).Y + dir(j).Z * dir(k).Z
                    If Math.Abs(dot) < cosTol Then Continue For
                    visited(k) = True
                    q.Enqueue(k)
                Next
            Loop
            totalLenCm += groupLen
        Next

        bendCount = groups
        bendLengthMm = totalLenCm * 10.0
    Catch
        bendCount = 0
        bendLengthMm = 0
    End Try
End Sub

Function EdgeLengthCm(e As Edge) As Double
    ' Curve length in Inventor database units (cm).
    Try
        Dim ev As CurveEvaluator = e.Evaluator
        Dim minP As Double = 0
        Dim maxP As Double = 0
        Dim length As Double = 0
        ev.GetParamExtents(minP, maxP)
        ev.GetLengthAtParam(minP, maxP, length)
        Return length
    Catch
        Return 0
    End Try
End Function

Function ShareEndpointPts(a1 As Point, a2 As Point, b1 As Point, b2 As Point, tol As Double) As Boolean
    ' True if two segments share an endpoint within tol (distance squared).
    If a1 Is Nothing OrElse a2 Is Nothing OrElse b1 Is Nothing OrElse b2 Is Nothing Then Return False
    Dim t2 As Double = tol * tol
    Return Dist2(a1, b1) <= t2 OrElse Dist2(a1, b2) <= t2 OrElse Dist2(a2, b1) <= t2 OrElse Dist2(a2, b2) <= t2
End Function

Function Dist2(a As Point, b As Point) As Double
    Dim dx As Double = a.X - b.X
    Dim dy As Double = a.Y - b.Y
    Dim dz As Double = a.Z - b.Z
    Return dx * dx + dy * dy + dz * dz
End Function

'===== PRICING ================================================================

Function CalcMaterialCost(hasWeight As Boolean, weightKg As Double, _
                          hasArea As Boolean, areaMm2 As Double, _
                          hasBlank As Boolean, blankAreaMm2 As Double) As Double?
    ' Material cost from CfgMaterialNet / CfgMaterialPricePerKg settings.
    ' Area and blank are in mm2; convert to m2 with / 1e6 when pricing by area.
    If CfgMaterialNet() Then
        If CfgMaterialPricePerKg() Then
            If hasWeight AndAlso weightKg >= 0 Then Return weightKg * CfgMaterialPrice()
            Return Nothing
        Else
            If hasArea AndAlso areaMm2 > 0 Then Return (areaMm2 / 1000000.0) * CfgMaterialPrice()
            Return Nothing
        End If
    Else
        If CfgMaterialPricePerKg() Then
            ' Scale part mass by blank/net area ratio (gross material mass estimate)
            If Not hasBlank OrElse blankAreaMm2 <= 0 Then Return Nothing
            If Not hasArea OrElse areaMm2 <= 0 OrElse Not hasWeight OrElse weightKg < 0 Then Return Nothing
            Dim blankMass As Double = weightKg * (blankAreaMm2 / areaMm2)
            Return blankMass * CfgMaterialPrice()
        Else
            If hasBlank AndAlso blankAreaMm2 > 0 Then Return (blankAreaMm2 / 1000000.0) * CfgMaterialPrice()
            Return Nothing
        End If
    End If
End Function

Function CalcCutCost(hasLaser As Boolean, laserMm As Double, hasThk As Boolean, thkMm As Double) As Double?
    ' Laser: length * thickness * rate (all must be valid and > 0).
    If Not hasLaser OrElse laserMm <= 0 Then Return Nothing
    If Not hasThk OrElse thkMm <= 0 Then Return Nothing
    If CfgPricePerMmCutPer1MmThickness() <= 0 Then Return Nothing
    Return laserMm * thkMm * CfgPricePerMmCutPer1MmThickness()
End Function

Function CalcBendCost(hasCnt As Boolean, cnt As Integer) As Double?
    If Not hasCnt OrElse cnt <= 0 Then Return Nothing
    If CfgPricePerBend() <= 0 Then Return Nothing
    Return CDbl(cnt) * CfgPricePerBend()
End Function

Function CalcEngraverCost(hasLen As Boolean, lenMm As Double) As Double?
    If Not hasLen OrElse lenMm <= 0 Then Return Nothing
    If CfgPricePerMmBendLineEngraver() <= 0 Then Return Nothing
    Return lenMm * CfgPricePerMmBendLineEngraver()
End Function

Function FormatTotalPrice(matCost As Double?, cutCost As Double?, _
                          bendCost As Double?, engCost As Double?) As String
    ' Work = cut + bend + engraver. Total = material + work when material known.
    Dim workOnly As Double = 0
    If cutCost.HasValue Then workOnly += cutCost.Value
    If bendCost.HasValue Then workOnly += bendCost.Value
    If engCost.HasValue Then workOnly += engCost.Value

    If Not matCost.HasValue Then
        Return FmtNum(workOnly, 2) & " (work price, material excluded)"
    End If
    Return FmtNum(matCost.Value + workOnly, 2)
End Function

'===== TXT EXPORT =============================================================

Function BuildTxtPath(oDoc As Document) As String
    ' {folder}\{part}_{material}_{thickness}_{stamp}.txt
    Try
        Dim docPath As String = oDoc.FullFileName
        If IsBlank(docPath) Then Return ""

        Dim isSm As Boolean = False
        Dim partName As String = ""
        Dim thk As String = ""
        Dim mat As String = ""
        Dim w As String = ""
        Dim hasW As Boolean = False
        Dim wKg As Double = 0
        Dim hasT As Boolean = False
        Dim tMm As Double = 0
        GetPartInfo(oDoc, isSm, partName, thk, mat, w, hasW, wKg, hasT, tMm)

        Dim dir As String = System.IO.Path.GetDirectoryName(docPath)
        Dim baseName As String = System.IO.Path.GetFileNameWithoutExtension(docPath)
        Dim stamp As String = DateTime.Now.ToString("yyyy-MM-dd_HH-mm-ss", System.Globalization.CultureInfo.InvariantCulture)
        Dim fileName As String = baseName & "_" & SafeFilePart(mat) & "_" & SafeFilePart(thk) & "_" & stamp & ".txt"
        Return System.IO.Path.Combine(dir, fileName)
    Catch
        Return ""
    End Try
End Function

Function SafeFilePart(value As String) As String
    ' Strip characters illegal in Windows file names.
    If String.IsNullOrWhiteSpace(value) OrElse value = UndefLabel() Then Return "unknown"
    Dim s As String = value.Trim()
    Dim bad As String = "\:*?""<>|/"
    Dim i As Integer
    For i = 1 To bad.Length
        s = s.Replace(bad.Substring(i - 1, 1), "_")
    Next
    s = System.Text.RegularExpressions.Regex.Replace(s, "\s+", "_")
    If IsBlank(s) Then s = "unknown"
    Return s
End Function

Function WriteTextFile(path As String, content As String) As Boolean
    Try
        System.IO.File.WriteAllText(path, content, System.Text.Encoding.UTF8)
        Return True
    Catch
        Return False
    End Try
End Function
'==============================================================================
' ObliczeniaBlach.iLogicVb - Autodesk Inventor iLogic rule (single file)
' Analog of SheetMetalCalc.bas (SolidWorks) / Preliminary Cost Estimate panel.
'
' WHAT THIS RULE DOES
'   For the active sheet-metal Part:
'     - reads part name / thickness / material / weight
'     - ensures FlatPattern (Unfold if missing)
'     - measures area, blank (+ allowance), laser path, bend count / length
'     - computes material / cut / bend / engraver / total price
'   Shows a text report (MsgBox) and optionally saves .txt next to the model:
'     {name}_{material}_{thickness}_{yyyy-MM-dd_HH-mm-ss}.txt
'
' HOW TO USE
'   1) Edit SETTINGS (Cfg* Functions below) - prices, allowance, TXT, notify.
'   2) Inventor: External Rules -> Add Rule -> select this .iLogicVb
'      (prefer local disk, not W:\ / OneDrive - same tip as Save.iLogicVb).
'   3) Open a SAVED sheet-metal Part, run the rule.
'
' CONFIG (Cfg*) - change Return values only:
'   CfgDecimalPlaces, CfgMaterialAllowanceMm, CfgPricePerBend,
'   CfgPricePerMmBendLineEngraver, CfgPricePerMmCutPer1MmThickness,
'   CfgMaterialPrice, CfgMaterialPricePerKg, CfgMaterialNet,
'   CfgExportTxt, CfgNotify
'
' RETURN / REPORT
'   BuildReport() always returns text. Empty / error lines mean calculation failed.
'   Settings block is appended so a TXT export can restore inputs later.
'
' NOTES FOR BEGINNERS
'   - iLogic = VB.NET (not VBA). Sub Main must come first.
'   - Do NOT put Dim / Const / Shared above Main - iLogic will not compile.
'     Settings are Functions that Return a value (same idea as VBA Const / Save.iLogicVb).
'   - ThisApplication is given by iLogic.
'   - Inventor database length = cm -> mm via *10; area cm2 -> mm2 via *100.
'   - Use "mm2" (ASCII), not Unicode superscript - safer in MsgBox / TXT.
'==============================================================================

'===== ENTRY ==================================================================

Sub Main()
    ' ok: True when we produced a usable report (and optional TXT write succeeded)
    Dim report As String = ""
    Dim path As String = ""
    Dim ok As Boolean = True

    Try
        Dim oDoc As Document = ThisApplication.ActiveDocument
        If oDoc Is Nothing Then
            MsgBox("No document open.", MsgBoxStyle.Exclamation, "SheetMetalCalc")
            Return
        End If

        report = BuildReport(oDoc)
        ' Heuristic: short "not a sheet part" / empty is still a report, but mark fail for icon
        ok = (report.Length > 0) AndAlso _
             (report.IndexOf("No document", StringComparison.OrdinalIgnoreCase) < 0) AndAlso _
             (report.IndexOf("not a sheet part", StringComparison.OrdinalIgnoreCase) < 0)

        ' Optional TXT next to the model (needs FullFileName)
        If CfgExportTxt() AndAlso ok AndAlso HasSavedPath(oDoc) Then
            path = BuildTxtPath(oDoc)
            If path.Length > 0 Then
                If WriteTextFile(path, report) Then
                    report = report & vbCrLf & ModuleSep() & vbCrLf & _
                             PadKey("export") & " - " & path
                Else
                    report = report & vbCrLf & ModuleSep() & vbCrLf & _
                             "Export failed: could not write TXT."
                    ok = False
                End If
            End If
        End If

        If CfgNotify() = 1 OrElse Not ok Then
            Dim icon As MsgBoxStyle = If(ok, MsgBoxStyle.Information, MsgBoxStyle.Exclamation)
            MsgBox(report, icon, "SheetMetalCalc")
        End If
    Catch ex As Exception
        MsgBox("SheetMetalCalc error: " & ex.Message, MsgBoxStyle.Critical, "SheetMetalCalc")
    End Try
End Sub

'----- SETTINGS (edit Return values) ------------------------------------------
' *** EDIT ONLY THIS BLOCK to configure prices / allowance / export ***
' Same meaning as the SW panel / SheetMetalCalc.bas inputs.
' Change the Return value, then save the rule and run again.
' Implemented as Functions: iLogic forbids module-level Const/fields
' (same pattern as Save.iLogicVb CfgExportPdf / CfgNotify / ...).

Function CfgDecimalPlaces() As Integer
    ' How many digits after the decimal in report numbers (area, blank, prices, ...).
    ' Example: 2 -> "12.50"; 0 -> "13".
    Return 2
End Function

Function CfgMaterialAllowanceMm() As Double
    ' Extra stock on EACH side of the blank (mm).
    ' Blank size = flat Length/Width + 2 * allowance (both sides).
    ' Example: 1.0 -> +1 mm left and +1 mm right (same for height).
    Return 1.0
End Function

Function CfgPricePerBend() As Double
    ' Money charged PER bend (bend count from flat-pattern bend edges).
    ' Bending price = bendCount * CfgPricePerBend.
    Return 2.0
End Function

Function CfgPricePerMmBendLineEngraver() As Double
    ' Money per mm of bend CENTERLINE (engraver / marking along the bend).
    ' Engraver price = totalBendLengthMm * this rate.
    Return 0.1
End Function

Function CfgPricePerMmCutPer1MmThickness() As Double
    ' Laser cutting rate.
    ' Cutting price = laserPathLengthMm * thicknessMm * this rate.
    ' (Longer cut and thicker sheet = higher price.)
    Return 13.55
End Function

Function CfgMaterialPrice() As Double
    ' Material unit price. Unit depends on CfgMaterialPricePerKg:
    '   True  -> currency per 1 kg
    '   False -> currency per 1 m2
    Return 12.0
End Function

Function CfgMaterialPricePerKg() As Boolean
    ' How to interpret CfgMaterialPrice:
    '   True  = Per 1 kg (uses part mass / estimated blank mass)
    '   False = Per 1 m2 (uses net area or blank area in m2)
    Return True
End Function

Function CfgMaterialNet() As Boolean
    ' Which area drives material quantity:
    '   True  = Area (Net)  - unfolded face area / mass of the part
    '   False = Blank (Gross) - rectangular blank including allowance
    Return False
End Function

Function CfgExportTxt() As Boolean
    ' True  = also save the report as .txt next to the part file
    '         name: {part}_{material}_{thickness}_{yyyy-MM-dd_HH-mm-ss}.txt
    ' False = only MsgBox, no file
    Return True
End Function

Function CfgNotify() As Integer
    ' 0 = show MsgBox only when something failed
    ' 1 = always show the full report MsgBox (default)
    Return 1
End Function

'----- FIXED LABELS (usually do not edit) -------------------------------------
' Layout helpers for the text report - not pricing settings.

Function KeyCol() As Integer
    ' Pad width for short report keys ("part", "thickness", "price", ...).
    Return 12
End Function

Function SettingsKeyCol() As Integer
    ' Pad width for the Settings block keys (longer labels).
    Return 24
End Function

Function ModuleSep() As String
    ' Separator line between report sections ("---").
    Return "---"
End Function

Function UndefLabel() As String
    ' Placeholder when thickness / material / name cannot be read.
    Return "undefined"
End Function

Function SheetMetalSubtype() As String
    ' Inventor Part SubType GUID that marks a sheet-metal part.
    Return "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
End Function

'===== REPORT =================================================================

Function BuildReport(oDoc As Document) As String
    ' Build the full human-readable cost report for one sheet-metal part.
    Dim isSm As Boolean = False
    Dim infoPart As String = UndefLabel()
    Dim infoThk As String = UndefLabel()
    Dim infoMat As String = UndefLabel()
    Dim infoW As String = UndefLabel()
    Dim hasWeight As Boolean = False
    Dim hasThk As Boolean = False
    Dim weightKg As Double = 0
    Dim thkMm As Double = 0
    Dim canMsg As String = ""
    Dim areaMm2 As Double = 0
    Dim blankL As Double = 0
    Dim blankW As Double = 0
    Dim blankA As Double = 0
    Dim laserMm As Double = 0
    Dim bendLenMm As Double = 0
    Dim bendCnt As Integer = 0
    Dim hasArea As Boolean = False
    Dim hasBlank As Boolean = False
    Dim hasLaser As Boolean = False
    Dim hasBendCnt As Boolean = False
    Dim hasBendLen As Boolean = False
    Dim hasOverlap As Boolean = False
    Dim overlapMsg As String = ""
    Dim matCost As Double? = Nothing
    Dim cutCost As Double? = Nothing
    Dim bendCost As Double? = Nothing
    Dim engCost As Double? = Nothing
    Dim totalTxt As String = ""
    Dim modules As String = ""
    Dim sheetBlock As String = ""
    Dim engBlock As String = ""

    GetPartInfo(oDoc, isSm, infoPart, infoThk, infoMat, infoW, hasWeight, weightKg, hasThk, thkMm)

    If Not isSm Then
        Return "Document is not a sheet part." & vbCrLf & _
               "(Open a part with Flat Pattern / sheet metal.)" & _
               vbCrLf & ModuleSep() & vbCrLf & BuildSettingsBlock()
    End If

    If Not CanFlatten(oDoc, canMsg) Then
        Return PartHeader(infoPart, infoThk, infoMat, hasWeight, infoW) & _
               PadKey("price") & " - (not calculated)" & vbCrLf & _
               ModuleSep() & vbCrLf & canMsg & _
               vbCrLf & ModuleSep() & vbCrLf & BuildSettingsBlock()
    End If

    If Not CalcOnFlatPattern(oDoc, areaMm2, hasArea, blankL, blankW, blankA, hasBlank, _
                             laserMm, hasLaser, bendCnt, hasBendCnt, bendLenMm, hasBendLen, _
                             hasOverlap, overlapMsg) Then
        Return PartHeader(infoPart, infoThk, infoMat, hasWeight, infoW) & _
               PadKey("price") & " - (not calculated)" & vbCrLf & _
               ModuleSep() & vbCrLf & _
               "Cannot flatten this part: Flat-Pattern/Flatten operation is unavailable." & _
               vbCrLf & ModuleSep() & vbCrLf & BuildSettingsBlock()
    End If

    If hasOverlap Then
        Return PartHeader(infoPart, infoThk, infoMat, hasWeight, infoW) & _
               PadKey("price") & " - (not calculated)" & vbCrLf & _
               ModuleSep() & vbCrLf & _
               Nz(overlapMsg, "Geometry check found issues in flat pattern.") & _
               vbCrLf & ModuleSep() & vbCrLf & BuildSettingsBlock()
    End If

    ' No bends -> bend length is zero (engraver line not needed)
    If hasBendCnt AndAlso bendCnt <= 0 Then
        bendLenMm = 0
        hasBendLen = True
    End If

    matCost = CalcMaterialCost(hasWeight, weightKg, hasArea, areaMm2, hasBlank, blankA)
    cutCost = CalcCutCost(hasLaser, laserMm, hasThk, thkMm)
    bendCost = CalcBendCost(hasBendCnt, bendCnt)
    engCost = CalcEngraverCost(hasBendLen, bendLenMm)
    totalTxt = FormatTotalPrice(matCost, cutCost, bendCost, engCost)

    modules = PartHeader(infoPart, infoThk, infoMat, hasWeight, infoW) & _
              PadKey("price") & " - " & totalTxt

    ' --- Sheet / laser / bends block ---
    sheetBlock = "Sheet OK" & vbCrLf
    If hasArea Then
        sheetBlock &= PadKey("area") & " - " & FmtNum(areaMm2, CfgDecimalPlaces()) & " mm2" & vbCrLf
    End If
    If hasBlank Then
        sheetBlock &= PadKey("blank") & " - " & _
                      FmtNum(blankL, CfgDecimalPlaces()) & " x " & FmtNum(blankW, CfgDecimalPlaces()) & " mm (" & _
                      FmtNum(blankA, CfgDecimalPlaces()) & " mm2), allowance +" & _
                      FmtNumG(CfgMaterialAllowanceMm()) & " mm per side (from settings)" & vbCrLf
    End If
    sheetBlock &= PadKey("material price") & " - " & FormatMoney(matCost) & vbCrLf
    sheetBlock &= ModuleSep() & vbCrLf & "Laser cut" & vbCrLf
    If hasLaser Then
        sheetBlock &= PadKey("length") & " - " & FmtNum(laserMm, CfgDecimalPlaces()) & " mm" & vbCrLf
        sheetBlock &= PadKey("cutting price") & " - " & FormatMoney(cutCost) & vbCrLf
    Else
        sheetBlock &= PadKey("length") & " - -" & vbCrLf
        sheetBlock &= PadKey("cutting price") & " - (not calculated)" & vbCrLf
    End If
    sheetBlock &= ModuleSep() & vbCrLf & "Bends" & vbCrLf
    sheetBlock &= PadKey("count") & " - " & If(hasBendCnt, bendCnt.ToString(), "0") & vbCrLf
    sheetBlock &= PadKey("bending price") & " - " & FormatMoney(bendCost)
    modules &= vbCrLf & ModuleSep() & vbCrLf & sheetBlock

    ' --- Engraver block (price along bend lines) ---
    engBlock = "Engraver" & vbCrLf
    If hasBendLen Then
        engBlock &= PadKey("length") & " - " & FmtNum(bendLenMm, CfgDecimalPlaces()) & " mm" & vbCrLf
    Else
        engBlock &= PadKey("length") & " - -" & vbCrLf
    End If
    engBlock &= PadKey("rate") & " - " & FmtNumG(CfgPricePerMmBendLineEngraver()) & vbCrLf
    engBlock &= PadKey("price") & " - " & FormatMoney(engCost)
    modules &= vbCrLf & ModuleSep() & vbCrLf & engBlock

    modules &= vbCrLf & ModuleSep() & vbCrLf & BuildSettingsBlock()
    Return modules
End Function

Function PartHeader(partName As String, thk As String, mat As String, _
                    hasWeight As Boolean, weight As String) As String
    ' First lines of every report: part / thickness / material [/ weight].
    Dim s As String = PadKey("part") & " - " & partName & " loaded" & vbCrLf & _
                      PadKey("thickness") & " - " & thk & vbCrLf & _
                      PadKey("material") & " - " & mat & vbCrLf
    If hasWeight Then s &= PadKey("weight") & " - " & weight & vbCrLf
    Return s
End Function

Function BuildSettingsBlock() As String
    ' Appended to every report so TXT export records the inputs that were used.
    Dim s As String = "Settings" & vbCrLf
    s &= PadSettingsKey("decimal places") & " - " & ClampDec(CfgDecimalPlaces()).ToString() & vbCrLf
    s &= PadSettingsKey("material allowance") & " - " & FmtNumG(CfgMaterialAllowanceMm()) & " mm" & vbCrLf
    s &= PadSettingsKey("price per bend") & " - " & FmtNumG(CfgPricePerBend()) & vbCrLf
    s &= PadSettingsKey("price per mm engraver") & " - " & FmtNumG(CfgPricePerMmBendLineEngraver()) & vbCrLf
    s &= PadSettingsKey("price per mm cut") & " - " & FmtNumG(CfgPricePerMmCutPer1MmThickness()) & vbCrLf
    s &= PadSettingsKey("material price") & " - " & FmtNumG(CfgMaterialPrice()) & vbCrLf
    s &= PadSettingsKey("material price unit") & " - " & If(CfgMaterialPricePerKg(), "Per 1 kg", "Per 1 m2") & vbCrLf
    s &= PadSettingsKey("material quantity") & " - " & If(CfgMaterialNet(), "Area", "Blank")
    Return s
End Function

'===== SMALL HELPERS ==========================================================

Function IsBlank(s As String) As Boolean
    Return String.IsNullOrEmpty(s)
End Function

Function Nz(value As String, fallback As String) As String
    If IsBlank(value) Then Return fallback
    Return value
End Function

Function HasSavedPath(oDoc As Document) As Boolean
    ' Unsaved docs have empty FullFileName - cannot write TXT next to model.
    Try
        Return Not IsBlank(oDoc.FullFileName)
    Catch
        Return False
    End Try
End Function

Function PadKey(key As String) As String
    ' Left-align key in a fixed column so the report looks like a table.
    If key.Length >= KeyCol() Then Return key
    Return key & New String(" "c, KeyCol() - key.Length)
End Function

Function PadSettingsKey(key As String) As String
    If key.Length >= SettingsKeyCol() Then Return key
    Return key & New String(" "c, SettingsKeyCol() - key.Length)
End Function

Function FmtNum(v As Double, dec As Integer) As String
    ' Fixed decimal places, invariant culture (dot as decimal separator).
    Return v.ToString("F" & ClampDec(dec).ToString(), System.Globalization.CultureInfo.InvariantCulture)
End Function

Function FmtNumG(v As Double) As String
    ' General format (settings / rates).
    Return v.ToString("G", System.Globalization.CultureInfo.InvariantCulture)
End Function

Function FormatMoney(v As Double?) As String
    ' Nullable Double: Nothing -> "(not calculated)".
    If Not v.HasValue Then Return "(not calculated)"
    Return FmtNum(v.Value, 2)
End Function

Function ClampDec(n As Integer) As Integer
    If n < 0 Then Return 0
    If n > 10 Then Return 10
    Return n
End Function

'===== PART INFO ==============================================================

Sub GetPartInfo(oDoc As Document, ByRef isSm As Boolean, ByRef partName As String, _
                ByRef thickness As String, ByRef material As String, ByRef weight As String, _
                ByRef hasWeight As Boolean, ByRef weightKg As Double, _
                ByRef hasThk As Boolean, ByRef thkMm As Double)
    ' Fill display strings + numeric thickness/weight for pricing.
    isSm = False
    partName = UndefLabel()
    thickness = UndefLabel()
    material = UndefLabel()
    weight = UndefLabel()
    hasWeight = False
    weightKg = 0
    hasThk = False
    thkMm = 0

    Try
        partName = oDoc.DisplayName
        If IsBlank(partName) Then partName = UndefLabel()
    Catch
        partName = UndefLabel()
    End Try

    If Not IsSheetMetalPart(oDoc) Then Return
    isSm = True

    Try
        Dim sm As SheetMetalComponentDefinition = GetSmDef(oDoc)
        thkMm = sm.Thickness.Value * 10.0 ' cm -> mm
        If thkMm > 0 Then
            hasThk = True
            thickness = FmtNum(thkMm, CfgDecimalPlaces()) & " mm"
        End If
    Catch
    End Try

    Try
        Dim pDoc As PartDocument = CType(oDoc, PartDocument)
        Dim mat As Material = pDoc.ActiveMaterial
        If mat IsNot Nothing AndAlso Not String.IsNullOrWhiteSpace(mat.DisplayName) Then
            material = mat.DisplayName
        End If
    Catch
        material = UndefLabel()
    End Try

    ' Mass only if material is known (same rule as SW panel)
    If material <> UndefLabel() Then
        Try
            Dim sm As SheetMetalComponentDefinition = GetSmDef(oDoc)
            Dim mass As Double = sm.MassProperties.Mass
            If mass >= 0 Then
                hasWeight = True
                weightKg = mass
                weight = FmtNum(mass, CfgDecimalPlaces()) & " kg"
            End If
        Catch
            hasWeight = False
        End Try
    End If
End Sub

Function IsSheetMetalPart(oDoc As Document) As Boolean
    Try
        If oDoc.DocumentType <> DocumentTypeEnum.kPartDocumentObject Then Return False
        Dim pDoc As PartDocument = CType(oDoc, PartDocument)
        If String.Equals(pDoc.SubType, SheetMetalSubtype(), StringComparison.OrdinalIgnoreCase) Then Return True
        Return TypeOf pDoc.ComponentDefinition Is SheetMetalComponentDefinition
    Catch
        Return False
    End Try
End Function

Function GetSmDef(oDoc As Document) As SheetMetalComponentDefinition
    ' Call only after IsSheetMetalPart is True.
    Dim pDoc As PartDocument = CType(oDoc, PartDocument)
    Return CType(pDoc.ComponentDefinition, SheetMetalComponentDefinition)
End Function

'===== FLATTEN / GEOMETRY =====================================================

Function CanFlatten(oDoc As Document, ByRef msg As String) As Boolean
    ' Ensure a FlatPattern exists (Unfold if needed). msg explains failure.
    msg = ""
    Try
        If Not IsSheetMetalPart(oDoc) Then
            msg = "Active document is not a part."
            Return False
        End If

        Dim sm As SheetMetalComponentDefinition = GetSmDef(oDoc)
        If Not sm.HasFlatPattern Then
            Try
                sm.Unfold()
            Catch
                msg = "Cannot flatten this part: Flat-Pattern/Flatten operation is unavailable."
                Return False
            End Try
        End If

        If sm.FlatPattern Is Nothing Then
            msg = "Cannot flatten this part: Flat pattern body is unavailable."
            Return False
        End If

        msg = "Flat pattern is available."
        Return True
    Catch
        msg = "Cannot flatten this part: an error occurred while preparing Flat Pattern."
        Return False
    End Try
End Function

Function CalcOnFlatPattern(oDoc As Document, _
                           ByRef areaMm2 As Double, ByRef hasArea As Boolean, _
                           ByRef blankL As Double, ByRef blankW As Double, ByRef blankA As Double, ByRef hasBlank As Boolean, _
                           ByRef laserMm As Double, ByRef hasLaser As Boolean, _
                           ByRef bendCnt As Integer, ByRef hasBendCnt As Boolean, _
                           ByRef bendLenMm As Double, ByRef hasBendLen As Boolean, _
                           ByRef hasOverlap As Boolean, ByRef overlapMsg As String) As Boolean
    ' Measure manufacturing geometry on the flat pattern.
    hasArea = False : hasBlank = False : hasLaser = False
    hasBendCnt = False : hasBendLen = False
    hasOverlap = False
    overlapMsg = ""

    Try
        Dim sm As SheetMetalComponentDefinition = GetSmDef(oDoc)
        If Not sm.HasFlatPattern Then
            Try
                sm.Unfold()
            Catch
                Return False
            End Try
        End If

        Dim fp As FlatPattern = sm.FlatPattern
        If fp Is Nothing Then Return False

        ' Inventor has no Body.Check2 like the SW panel - skip overlap, treat as OK
        hasOverlap = False
        overlapMsg = "Geometry check skipped (Inventor)."

        ' Area: TopFace evaluator returns cm2 -> mm2 (*100)
        Try
            Dim areaCm2 As Double = fp.TopFace.Evaluator.Area
            If areaCm2 > 0 Then
                areaMm2 = areaCm2 * 100.0
                hasArea = True
            End If
        Catch
        End Try

        ' Blank: FlatPattern Length/Width (cm->*10) + allowance per side
        Try
            Dim lenMm As Double = fp.Length * 10.0
            Dim widMm As Double = fp.Width * 10.0
            Dim allow As Double = CfgMaterialAllowanceMm()
            If lenMm >= widMm Then
                blankL = lenMm + 2.0 * allow
                blankW = widMm + 2.0 * allow
            Else
                blankL = widMm + 2.0 * allow
                blankW = lenMm + 2.0 * allow
            End If
            blankA = blankL * blankW
            hasBlank = True
        Catch
        End Try

        ' Laser path: sum of all TopFace edge-loop lengths (outer + holes), cm -> mm
        Try
            Dim totalCm As Double = 0
            Dim mt As MeasureTools = ThisApplication.MeasureTools
            Dim lp As EdgeLoop
            For Each lp In fp.TopFace.EdgeLoops
                totalCm += mt.GetLoopLength(lp)
            Next
            If totalCm > 0 Then
                laserMm = totalCm * 10.0
                hasLaser = True
            End If
        Catch
        End Try

        ' Bends: unique bend edges on top face (up + down), grouped if colinear
        Dim bc As Integer = 0
        Dim blMm As Double = 0
        GetBendMetrics(fp, bc, blMm)
        bendCnt = bc
        bendLenMm = blMm
        hasBendCnt = True
        hasBendLen = True

        Return True
    Catch
        Return False
    End Try
End Function

Sub GetBendMetrics(fp As FlatPattern, ByRef bendCount As Integer, ByRef bendLengthMm As Double)
    ' Count bends and total bend-line length on the flat pattern.
    ' Preferred: kBendUp / kBendDown edges, merge colinear connected pieces.
    ' Fallback: FlatBendResults (divide by 2 because top+bottom duplicates).
    bendCount = 0
    bendLengthMm = 0
    Try
        Dim edges As New List(Of Edge)
        Try
            Dim up As Edges = fp.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendUpFlatPatternEdge, True)
            Dim e As Edge
            For Each e In up
                edges.Add(e)
            Next
        Catch
        End Try
        Try
            Dim down As Edges = fp.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendDownFlatPatternEdge, True)
            Dim e2 As Edge
            For Each e2 In down
                edges.Add(e2)
            Next
        Catch
        End Try

        If edges.Count = 0 Then
            Try
                Dim res As FlatBendResults = fp.FlatBendResults
                If res IsNot Nothing AndAlso res.Count > 0 Then
                    bendCount = CInt(Math.Ceiling(res.Count / 2.0))
                    Dim totalCm As Double = 0
                    Dim i As Integer
                    For i = 1 To res.Count
                        Try
                            If Not res.Item(i).IsOnBottomFace Then
                                totalCm += EdgeLengthCm(res.Item(i).Edge)
                            End If
                        Catch
                        End Try
                    Next
                    bendLengthMm = totalCm * 10.0
                End If
            Catch
            End Try
            Return
        End If

        ' Precompute length / endpoints / direction for each bend edge
        Dim n As Integer = edges.Count
        Dim visited(n - 1) As Boolean
        Dim lens(n - 1) As Double
        Dim p1(n - 1) As Point
        Dim p2(n - 1) As Point
        Dim dir(n - 1) As UnitVector
        Dim tg As TransientGeometry = ThisApplication.TransientGeometry
        Dim iEdge As Integer

        For iEdge = 0 To n - 1
            lens(iEdge) = EdgeLengthCm(edges(iEdge))
            Try
                p1(iEdge) = edges(iEdge).StartVertex.Point
                p2(iEdge) = edges(iEdge).StopVertex.Point
                Dim vx As Double = p2(iEdge).X - p1(iEdge).X
                Dim vy As Double = p2(iEdge).Y - p1(iEdge).Y
                Dim vz As Double = p2(iEdge).Z - p1(iEdge).Z
                Dim len As Double = Math.Sqrt(vx * vx + vy * vy + vz * vz)
                If len > 0.0000001 Then
                    dir(iEdge) = tg.CreateUnitVector(vx / len, vy / len, vz / len)
                Else
                    dir(iEdge) = Nothing
                End If
            Catch
                dir(iEdge) = Nothing
            End Try
        Next

        ' BFS: connect edges that share an endpoint and are nearly parallel
        Dim groups As Integer = 0
        Dim totalLenCm As Double = 0
        Dim tol As Double = 0.0001
        Dim cosTol As Double = 0.9999

        For iEdge = 0 To n - 1
            If visited(iEdge) OrElse dir(iEdge) Is Nothing Then Continue For
            groups += 1
            Dim q As New Queue(Of Integer)
            visited(iEdge) = True
            q.Enqueue(iEdge)
            Dim groupLen As Double = 0

            Do While q.Count > 0
                Dim j As Integer = q.Dequeue()
                groupLen += lens(j)
                Dim k As Integer
                For k = 0 To n - 1
                    If visited(k) OrElse dir(k) Is Nothing Then Continue For
                    If Not ShareEndpointPts(p1(j), p2(j), p1(k), p2(k), tol) Then Continue For
                    Dim dot As Double = dir(j).X * dir(k).X + dir(j).Y * dir(k).Y + dir(j).Z * dir(k).Z
                    If Math.Abs(dot) < cosTol Then Continue For
                    visited(k) = True
                    q.Enqueue(k)
                Next
            Loop
            totalLenCm += groupLen
        Next

        bendCount = groups
        bendLengthMm = totalLenCm * 10.0
    Catch
        bendCount = 0
        bendLengthMm = 0
    End Try
End Sub

Function EdgeLengthCm(e As Edge) As Double
    ' Curve length in Inventor database units (cm).
    Try
        Dim ev As CurveEvaluator = e.Evaluator
        Dim minP As Double = 0
        Dim maxP As Double = 0
        Dim length As Double = 0
        ev.GetParamExtents(minP, maxP)
        ev.GetLengthAtParam(minP, maxP, length)
        Return length
    Catch
        Return 0
    End Try
End Function

Function ShareEndpointPts(a1 As Point, a2 As Point, b1 As Point, b2 As Point, tol As Double) As Boolean
    ' True if two segments share an endpoint within tol (distance squared).
    If a1 Is Nothing OrElse a2 Is Nothing OrElse b1 Is Nothing OrElse b2 Is Nothing Then Return False
    Dim t2 As Double = tol * tol
    Return Dist2(a1, b1) <= t2 OrElse Dist2(a1, b2) <= t2 OrElse Dist2(a2, b1) <= t2 OrElse Dist2(a2, b2) <= t2
End Function

Function Dist2(a As Point, b As Point) As Double
    Dim dx As Double = a.X - b.X
    Dim dy As Double = a.Y - b.Y
    Dim dz As Double = a.Z - b.Z
    Return dx * dx + dy * dy + dz * dz
End Function

'===== PRICING ================================================================

Function CalcMaterialCost(hasWeight As Boolean, weightKg As Double, _
                          hasArea As Boolean, areaMm2 As Double, _
                          hasBlank As Boolean, blankAreaMm2 As Double) As Double?
    ' Material cost from CfgMaterialNet / CfgMaterialPricePerKg settings.
    ' Area and blank are in mm2; convert to m2 with / 1e6 when pricing by area.
    If CfgMaterialNet() Then
        If CfgMaterialPricePerKg() Then
            If hasWeight AndAlso weightKg >= 0 Then Return weightKg * CfgMaterialPrice()
            Return Nothing
        Else
            If hasArea AndAlso areaMm2 > 0 Then Return (areaMm2 / 1000000.0) * CfgMaterialPrice()
            Return Nothing
        End If
    Else
        If CfgMaterialPricePerKg() Then
            ' Scale part mass by blank/net area ratio (gross material mass estimate)
            If Not hasBlank OrElse blankAreaMm2 <= 0 Then Return Nothing
            If Not hasArea OrElse areaMm2 <= 0 OrElse Not hasWeight OrElse weightKg < 0 Then Return Nothing
            Dim blankMass As Double = weightKg * (blankAreaMm2 / areaMm2)
            Return blankMass * CfgMaterialPrice()
        Else
            If hasBlank AndAlso blankAreaMm2 > 0 Then Return (blankAreaMm2 / 1000000.0) * CfgMaterialPrice()
            Return Nothing
        End If
    End If
End Function

Function CalcCutCost(hasLaser As Boolean, laserMm As Double, hasThk As Boolean, thkMm As Double) As Double?
    ' Laser: length * thickness * rate (all must be valid and > 0).
    If Not hasLaser OrElse laserMm <= 0 Then Return Nothing
    If Not hasThk OrElse thkMm <= 0 Then Return Nothing
    If CfgPricePerMmCutPer1MmThickness() <= 0 Then Return Nothing
    Return laserMm * thkMm * CfgPricePerMmCutPer1MmThickness()
End Function

Function CalcBendCost(hasCnt As Boolean, cnt As Integer) As Double?
    If Not hasCnt OrElse cnt <= 0 Then Return Nothing
    If CfgPricePerBend() <= 0 Then Return Nothing
    Return CDbl(cnt) * CfgPricePerBend()
End Function

Function CalcEngraverCost(hasLen As Boolean, lenMm As Double) As Double?
    If Not hasLen OrElse lenMm <= 0 Then Return Nothing
    If CfgPricePerMmBendLineEngraver() <= 0 Then Return Nothing
    Return lenMm * CfgPricePerMmBendLineEngraver()
End Function

Function FormatTotalPrice(matCost As Double?, cutCost As Double?, _
                          bendCost As Double?, engCost As Double?) As String
    ' Work = cut + bend + engraver. Total = material + work when material known.
    Dim workOnly As Double = 0
    If cutCost.HasValue Then workOnly += cutCost.Value
    If bendCost.HasValue Then workOnly += bendCost.Value
    If engCost.HasValue Then workOnly += engCost.Value

    If Not matCost.HasValue Then
        Return FmtNum(workOnly, 2) & " (work price, material excluded)"
    End If
    Return FmtNum(matCost.Value + workOnly, 2)
End Function

'===== TXT EXPORT =============================================================

Function BuildTxtPath(oDoc As Document) As String
    ' {folder}\{part}_{material}_{thickness}_{stamp}.txt
    Try
        Dim docPath As String = oDoc.FullFileName
        If IsBlank(docPath) Then Return ""

        Dim isSm As Boolean = False
        Dim partName As String = ""
        Dim thk As String = ""
        Dim mat As String = ""
        Dim w As String = ""
        Dim hasW As Boolean = False
        Dim wKg As Double = 0
        Dim hasT As Boolean = False
        Dim tMm As Double = 0
        GetPartInfo(oDoc, isSm, partName, thk, mat, w, hasW, wKg, hasT, tMm)

        Dim dir As String = System.IO.Path.GetDirectoryName(docPath)
        Dim baseName As String = System.IO.Path.GetFileNameWithoutExtension(docPath)
        Dim stamp As String = DateTime.Now.ToString("yyyy-MM-dd_HH-mm-ss", System.Globalization.CultureInfo.InvariantCulture)
        Dim fileName As String = baseName & "_" & SafeFilePart(mat) & "_" & SafeFilePart(thk) & "_" & stamp & ".txt"
        Return System.IO.Path.Combine(dir, fileName)
    Catch
        Return ""
    End Try
End Function

Function SafeFilePart(value As String) As String
    ' Strip characters illegal in Windows file names.
    If String.IsNullOrWhiteSpace(value) OrElse value = UndefLabel() Then Return "unknown"
    Dim s As String = value.Trim()
    Dim bad As String = "\:*?""<>|/"
    Dim i As Integer
    For i = 1 To bad.Length
        s = s.Replace(bad.Substring(i - 1, 1), "_")
    Next
    s = System.Text.RegularExpressions.Regex.Replace(s, "\s+", "_")
    If IsBlank(s) Then s = "unknown"
    Return s
End Function

Function WriteTextFile(path As String, content As String) As Boolean
    Try
        System.IO.File.WriteAllText(path, content, System.Text.Encoding.UTF8)
        Return True
    Catch
        Return False
    End Try
End Function

All Inventor macrosSend a note about this macro