CadPaste

Inventor

Rules and macros for Autodesk Inventor.

Press / to focus search.

Inventor · iLogic · 1 day ago · updated today

Indicating the thickness of sheet materials on a drawing

iLogic
'==============================================================================
' iLogic_GruboscWskaznik.vb - Autodesk Inventor iLogic rule (single file)
' Thickness callout (leader note) on a drawing view.
'
' WHAT THIS RULE DOES
'   On the active Drawing (.idw / .dwg):
'     1) Click a view that references a Part (.ipt)
'        -> arrow tip = click point, text = thickness "x..."
'     2) Move mouse for live preview, click again to place the text
'   Sheet-metal Part: reads SheetMetal Thickness (linked FormattedText).
'   Regular Part: tries UserParameter named "Thickness".
'   If no parameter: plain text "x" + fallback 1.5 mm (not linked to model).
'   Esc cancels and removes the preview leader.
'
' HOW TO USE
'   1) Optional: edit CfgThicknessNumberFormat below (display digits).
'   2) Inventor: External Rules -> Add Rule -> select this .vb / .iLogicVb
'      (prefer local disk, not W:\ / OneDrive - same tip as Save.iLogicVb).
'   3) Open a Drawing, run the rule, click view then text position (Esc = cancel).
'
' CONFIG (Cfg*) - change Return value only:
'   CfgThicknessNumberFormat
'
' 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.
'     The one setting is a Function that Returns a value (same idea as Save.iLogicVb).
'   - ThisApplication is given by iLogic.
'   - Inventor database length = cm. Drawing notes / Point2d are in cm.
'     Thickness DISPLAY is in mm (cm * 10). Decimal comma for PL drawings.
'   - References: System.Windows.Forms (DoEvents loop while picking).
'   - Interaction logic lives in Class TwoPointPicker (fields OK inside Class).
'   - Class cannot call module-level Cfg* Functions (iLogic: "object reference").
'     Main reads Cfg* and assigns NumberFormat on the picker instance.
'   - All MsgBox / StatusBar text is English (ASCII-safe).
'==============================================================================

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

Sub Main()
    ' ThisApplication = Inventor session provided by iLogic.
    Dim invApp As Inventor.Application = ThisApplication

    ' This tool works only on drawings - cast fails for Part / Assembly.
    Dim oDrawDoc As DrawingDocument = TryCast(invApp.ActiveDocument, DrawingDocument)
    If oDrawDoc Is Nothing Then
        MsgBox("Open a drawing document (.idw/.dwg).", MsgBoxStyle.Exclamation, "Thickness indicator")
        Return
    End If

    ' TwoPointPicker: interactive click-1 (view+arrow) / click-2 (text position).
    Dim picker As New TwoPointPicker()
    picker.DrawDoc = oDrawDoc
    ' Pass Cfg into Class (Class must not call module Functions directly).
    picker.NumberFormat = CfgThicknessNumberFormat()

    ' False = user cancelled (Esc) or clicks incomplete - leave drawing unchanged.
    If Not picker.Run(invApp) Then Return

    ' Refresh sheet after the final leader note is placed.
    oDrawDoc.Update()
End Sub

'----- SETTINGS (edit Return value) -------------------------------------------
' Only number display format is configurable. Everything else is fixed in code.
' Implemented as Function: iLogic forbids module-level Const/fields
' (same pattern as Save.iLogicVb / ObliczeniaBlach.ilogicVb).

Function CfgThicknessNumberFormat() As String
    ' .NET format for the thickness number (InvariantCulture first, then ",").
    ' "0.###" = up to 3 decimals, trailing zeros trimmed (e.g. 1.5 -> "1,5").
    ' Change Return, save the rule, run again.
    Return "0.###"
End Function

'===== PICKER CLASS ===========================================================
' Owns InteractionEvents + MouseEvents for the two-click workflow.
' Public fields are filled for Main / callers; Private fields are session state.

Class TwoPointPicker
    ' Inventor Application used to create TransientGeometry / InteractionEvents.
    Private _app As Inventor.Application
    ' Interaction session (status bar text, Start/Stop, Esc -> OnTerminate).
    Private WithEvents _interact As InteractionEvents
    ' Mouse click + move while interaction is running.
    Private WithEvents _mouse As MouseEvents
    ' 1 = waiting for view/arrow click; 2 = waiting for text position click.
    Private _step As Integer
    ' True when Esc, second click, or terminate ends the DoEvents loop.
    Private _done As Boolean
    ' FormattedText built on click 1 (plain "x..." or linked <Parameter> XML).
    Private _noteText As String
    ' Temporary LeaderNote shown during move; kept as final note on click 2.
    Private _previewLeader As LeaderNote
    ' Last preview text position (cm) - used to ignore tiny mouse moves.
    Private _lastPreviewX As Double
    Private _lastPreviewY As Double
    ' False until the first preview leader exists.
    Private _hasPreviewPos As Boolean

    ' Drawing that receives the LeaderNote (set from Main).
    Public DrawDoc As DrawingDocument
    ' View chosen on click 1 (must reference a Part).
    Public SelectedView As DrawingView
    ' Text position (click 2) - sheet Point2d in cm.
    Public Point1 As Point2d
    ' Arrow tip (click 1) - sheet Point2d in cm.
    Public Point2 As Point2d
    ' Set from Main via CfgThicknessNumberFormat() - do not call Cfg* from Class.
    Public NumberFormat As String

    Public Function Run(app As Inventor.Application) As Boolean
        ' Start interactive pick. Returns True only if view + both points exist.
        _app = app
        _step = 1
        _done = False
        _hasPreviewPos = False

        ' CreateInteractionEvents: Inventor UI mode for custom mouse handling.
        _interact = _app.CommandManager.CreateInteractionEvents()
        _interact.StatusBarText = "Click 1/2: view and arrow tip (Esc = cancel)"
        _mouse = _interact.MouseEvents
        ' No snap-to-geometry inference - use raw model/sheet click coordinates.
        _mouse.PointInferenceEnabled = False
        ' Need move events for live leader preview in step 2.
        _mouse.MouseMoveEnabled = True
        _interact.Start()

        ' Keep the rule thread pumping Windows messages until _done.
        ' Without DoEvents the UI would freeze and clicks would not arrive.
        Do While Not _done
            System.Windows.Forms.Application.DoEvents()
        Loop

        _interact.Stop()
        ' Success only when all three results are set (Esc clears preview, leaves nulls).
        Return SelectedView IsNot Nothing AndAlso Point1 IsNot Nothing AndAlso Point2 IsNot Nothing
    End Function

    Private Sub _mouse_OnMouseClick(Button As MouseButtonEnum, ShiftKeys As ShiftStateEnum, ModelPosition As Inventor.Point, ViewPosition As Point2d, ByVal InvView As Inventor.View) Handles _mouse.OnMouseClick
        ' Only left button advances the workflow.
        If Button <> MouseButtonEnum.kLeftMouseButton Then Return

        ' ModelPosition is sheet space for drawing interaction (X/Y in cm).
        Dim pt As Point2d = _app.TransientGeometry.CreatePoint2d(ModelPosition.X, ModelPosition.Y)

        If _step = 1 Then
            ' ----- CLICK 1: pick view + arrow tip, build note text -----
            Dim oView As DrawingView = FindViewAtPoint(DrawDoc.ActiveSheet, pt)
            If oView Is Nothing Then
                MsgBox("Click inside a drawing view.", MsgBoxStyle.Exclamation, "Thickness indicator")
                Return
            End If

            ' View must point at a Part document (.ipt), not Assembly / Drawing.
            Dim oModel As Inventor.Document = oView.ReferencedDocumentDescriptor.ReferencedDocument
            If oModel Is Nothing OrElse oModel.DocumentType <> DocumentTypeEnum.kPartDocumentObject Then
                MsgBox("View must reference a part (.ipt).", MsgBoxStyle.Exclamation, "Thickness indicator")
                Return
            End If

            SelectedView = oView
            Point2 = pt
            _noteText = BuildThicknessFormattedText(CType(oModel, PartDocument), oView)
            _step = 2
            _interact.StatusBarText = "Click 2/2: text position (Esc = cancel)"
            ' First preview: text and arrow at the same point until mouse moves.
            ShowPreview(pt)
        Else
            ' ----- CLICK 2: lock text position; keep preview as the real note -----
            Point1 = pt
            ShowPreview(pt)
            ' Drop our reference without Delete - note stays on the sheet.
            _previewLeader = Nothing
            _done = True
        End If
    End Sub

    Private Sub _mouse_OnMouseMove(Button As MouseButtonEnum, ShiftKeys As ShiftStateEnum, ModelPosition As Inventor.Point, ViewPosition As Point2d, ByVal InvView As Inventor.View) Handles _mouse.OnMouseMove
        ' Live preview only after click 1 (arrow tip Point2 already known).
        If _step <> 2 OrElse Point2 Is Nothing Then Return
        ShowPreview(_app.TransientGeometry.CreatePoint2d(ModelPosition.X, ModelPosition.Y))
    End Sub

    Private Sub _interact_OnTerminate() Handles _interact.OnTerminate
        ' Esc / cancel / interaction ended before click 2.
        ' If we never finished, remove the temporary preview leader.
        If Not _done Then ClearPreview()
        _done = True
    End Sub

    Private Sub ShowPreview(textPt As Point2d)
        ' Rebuild LeaderNote at textPt -> Point2 (arrow).
        ' Skip moves smaller than 0.05 cm to avoid delete/add every pixel.
        If _hasPreviewPos AndAlso _
           Math.Abs(_lastPreviewX - textPt.X) < 0.05 AndAlso _
           Math.Abs(_lastPreviewY - textPt.Y) < 0.05 Then Return

        ClearPreview()

        ' LeaderNotes.Add expects: first point = text, last point = arrow tip.
        Dim oLeaderPts As ObjectCollection = _app.TransientObjects.CreateObjectCollection
        oLeaderPts.Add(textPt)
        oLeaderPts.Add(Point2)
        _previewLeader = DrawDoc.ActiveSheet.DrawingNotes.LeaderNotes.Add(oLeaderPts, "")
        ' FormattedText can be plain string or Inventor XML with <Parameter>.
        _previewLeader.FormattedText = _noteText
        ' Small dot arrowhead (less visual clutter than a filled arrow).
        _previewLeader.Leader.ArrowheadType = ArrowheadTypeEnum.kSmallDotArrowheadType

        _lastPreviewX = textPt.X
        _lastPreviewY = textPt.Y
        _hasPreviewPos = True
        DrawDoc.Update()
    End Sub

    Private Sub ClearPreview()
        ' Delete temporary leader if it still exists on the sheet.
        If _previewLeader Is Nothing Then Return
        Try
            _previewLeader.Delete()
        Catch
            ' Ignore if already deleted by the user / Inventor.
        End Try
        _previewLeader = Nothing
        _hasPreviewPos = False
    End Sub

    Private Function FindViewAtPoint(oSheet As Sheet, pt As Point2d) As DrawingView
        ' Hit-test: which DrawingView rectangle contains the sheet point (cm).
        ' Walk from last to first so the top-most (later) view wins when stacked.
        For i As Integer = oSheet.DrawingViews.Count To 1 Step -1
            Dim oView As DrawingView = oSheet.DrawingViews.Item(i)
            Dim pos As Point2d = oView.Position
            Dim halfW As Double = oView.Width / 2.0
            Dim halfH As Double = oView.Height / 2.0
            If pt.X >= pos.X - halfW AndAlso pt.X <= pos.X + halfW AndAlso _
               pt.Y >= pos.Y - halfH AndAlso pt.Y <= pos.Y + halfH Then
                Return oView
            End If
        Next
        Return Nothing
    End Function

    Private Function BuildThicknessFormattedText(oPart As PartDocument, oView As DrawingView) As String
        ' Build the LeaderNote string: "x" + value, optionally linked to Thickness.
        Dim thicknessParam As Parameter = Nothing
        ' Inventor Parameter.Value for length is cm. Fallback 1.5 mm = 0.15 cm.
        Dim thicknessInventorCm As Double = 0.15

        Dim cd As ComponentDefinition = oPart.ComponentDefinition
        If TypeOf cd Is SheetMetalComponentDefinition Then
            ' Sheet metal: Thickness is a first-class property (always present).
            thicknessParam = CType(cd, SheetMetalComponentDefinition).Thickness
            thicknessInventorCm = thicknessParam.Value
        Else
            ' Regular part: only if a UserParameter named "Thickness" exists.
            Try
                thicknessParam = oPart.ComponentDefinition.Parameters.UserParameters.Item("Thickness")
                thicknessInventorCm = thicknessParam.Value
            Catch
                ' Keep fallback 0.15 cm; thicknessParam stays Nothing -> plain text.
            End Try
        End If

        ' Display mm = cm * 10; format uses NumberFormat + decimal comma.
        Dim displayValue As String = FormatThicknessForDrawing(thicknessInventorCm * 10.0)

        If thicknessParam Is Nothing Then
            ' No model link - static text only (will not update if thickness changes).
            Return "x" & displayValue
        End If

        ' ComponentIdentifier: path Inventor uses to resolve the parameter later.
        Dim componentId As String = oPart.FullFileName
        If String.IsNullOrEmpty(componentId) Then
            ' Unsaved part - fall back to the view descriptor document name.
            componentId = oView.ReferencedDocumentDescriptor.FullDocumentName
        End If

        ' Linked FormattedText XML: Inventor refreshes the number when Thickness changes.
        ' Precision='3' = up to 3 digits after decimal in the linked display.
        Return "x<Parameter Resolved='True' ComponentIdentifier='" & EscapeXmlAttribute(componentId) & _
               "' Name='" & EscapeXmlAttribute(thicknessParam.Name) & _
               "' Precision='3'>" & displayValue & "</Parameter>"
    End Function

    Private Function EscapeXmlAttribute(value As String) As String
        ' FormattedText attributes use single quotes - escape ' inside paths/names.
        If String.IsNullOrEmpty(value) Then Return ""
        Return value.Replace("'"c, "&apos;")
    End Function

    Private Function FormatThicknessForDrawing(valueMm As Double) As String
        ' 1) Format with .NET pattern from Main (CfgThicknessNumberFormat).
        ' 2) Replace "." with "," for Polish drawing convention.
        Dim fmt As String = NumberFormat
        If String.IsNullOrEmpty(fmt) Then fmt = "0.###"
        Return valueMm.ToString(fmt, Globalization.CultureInfo.InvariantCulture).Replace("."c, ","c)
    End Function
End Class
'==============================================================================
' iLogic_GruboscWskaznik.vb - Autodesk Inventor iLogic rule (single file)
' Thickness callout (leader note) on a drawing view.
'
' WHAT THIS RULE DOES
'   On the active Drawing (.idw / .dwg):
'     1) Click a view that references a Part (.ipt)
'        -> arrow tip = click point, text = thickness "x..."
'     2) Move mouse for live preview, click again to place the text
'   Sheet-metal Part: reads SheetMetal Thickness (linked FormattedText).
'   Regular Part: tries UserParameter named "Thickness".
'   If no parameter: plain text "x" + fallback 1.5 mm (not linked to model).
'   Esc cancels and removes the preview leader.
'
' HOW TO USE
'   1) Optional: edit CfgThicknessNumberFormat below (display digits).
'   2) Inventor: External Rules -> Add Rule -> select this .vb / .iLogicVb
'      (prefer local disk, not W:\ / OneDrive - same tip as Save.iLogicVb).
'   3) Open a Drawing, run the rule, click view then text position (Esc = cancel).
'
' CONFIG (Cfg*) - change Return value only:
'   CfgThicknessNumberFormat
'
' 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.
'     The one setting is a Function that Returns a value (same idea as Save.iLogicVb).
'   - ThisApplication is given by iLogic.
'   - Inventor database length = cm. Drawing notes / Point2d are in cm.
'     Thickness DISPLAY is in mm (cm * 10). Decimal comma for PL drawings.
'   - References: System.Windows.Forms (DoEvents loop while picking).
'   - Interaction logic lives in Class TwoPointPicker (fields OK inside Class).
'   - Class cannot call module-level Cfg* Functions (iLogic: "object reference").
'     Main reads Cfg* and assigns NumberFormat on the picker instance.
'   - All MsgBox / StatusBar text is English (ASCII-safe).
'==============================================================================

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

Sub Main()
    ' ThisApplication = Inventor session provided by iLogic.
    Dim invApp As Inventor.Application = ThisApplication

    ' This tool works only on drawings - cast fails for Part / Assembly.
    Dim oDrawDoc As DrawingDocument = TryCast(invApp.ActiveDocument, DrawingDocument)
    If oDrawDoc Is Nothing Then
        MsgBox("Open a drawing document (.idw/.dwg).", MsgBoxStyle.Exclamation, "Thickness indicator")
        Return
    End If

    ' TwoPointPicker: interactive click-1 (view+arrow) / click-2 (text position).
    Dim picker As New TwoPointPicker()
    picker.DrawDoc = oDrawDoc
    ' Pass Cfg into Class (Class must not call module Functions directly).
    picker.NumberFormat = CfgThicknessNumberFormat()

    ' False = user cancelled (Esc) or clicks incomplete - leave drawing unchanged.
    If Not picker.Run(invApp) Then Return

    ' Refresh sheet after the final leader note is placed.
    oDrawDoc.Update()
End Sub

'----- SETTINGS (edit Return value) -------------------------------------------
' Only number display format is configurable. Everything else is fixed in code.
' Implemented as Function: iLogic forbids module-level Const/fields
' (same pattern as Save.iLogicVb / ObliczeniaBlach.ilogicVb).

Function CfgThicknessNumberFormat() As String
    ' .NET format for the thickness number (InvariantCulture first, then ",").
    ' "0.###" = up to 3 decimals, trailing zeros trimmed (e.g. 1.5 -> "1,5").
    ' Change Return, save the rule, run again.
    Return "0.###"
End Function

'===== PICKER CLASS ===========================================================
' Owns InteractionEvents + MouseEvents for the two-click workflow.
' Public fields are filled for Main / callers; Private fields are session state.

Class TwoPointPicker
    ' Inventor Application used to create TransientGeometry / InteractionEvents.
    Private _app As Inventor.Application
    ' Interaction session (status bar text, Start/Stop, Esc -> OnTerminate).
    Private WithEvents _interact As InteractionEvents
    ' Mouse click + move while interaction is running.
    Private WithEvents _mouse As MouseEvents
    ' 1 = waiting for view/arrow click; 2 = waiting for text position click.
    Private _step As Integer
    ' True when Esc, second click, or terminate ends the DoEvents loop.
    Private _done As Boolean
    ' FormattedText built on click 1 (plain "x..." or linked <Parameter> XML).
    Private _noteText As String
    ' Temporary LeaderNote shown during move; kept as final note on click 2.
    Private _previewLeader As LeaderNote
    ' Last preview text position (cm) - used to ignore tiny mouse moves.
    Private _lastPreviewX As Double
    Private _lastPreviewY As Double
    ' False until the first preview leader exists.
    Private _hasPreviewPos As Boolean

    ' Drawing that receives the LeaderNote (set from Main).
    Public DrawDoc As DrawingDocument
    ' View chosen on click 1 (must reference a Part).
    Public SelectedView As DrawingView
    ' Text position (click 2) - sheet Point2d in cm.
    Public Point1 As Point2d
    ' Arrow tip (click 1) - sheet Point2d in cm.
    Public Point2 As Point2d
    ' Set from Main via CfgThicknessNumberFormat() - do not call Cfg* from Class.
    Public NumberFormat As String

    Public Function Run(app As Inventor.Application) As Boolean
        ' Start interactive pick. Returns True only if view + both points exist.
        _app = app
        _step = 1
        _done = False
        _hasPreviewPos = False

        ' CreateInteractionEvents: Inventor UI mode for custom mouse handling.
        _interact = _app.CommandManager.CreateInteractionEvents()
        _interact.StatusBarText = "Click 1/2: view and arrow tip (Esc = cancel)"
        _mouse = _interact.MouseEvents
        ' No snap-to-geometry inference - use raw model/sheet click coordinates.
        _mouse.PointInferenceEnabled = False
        ' Need move events for live leader preview in step 2.
        _mouse.MouseMoveEnabled = True
        _interact.Start()

        ' Keep the rule thread pumping Windows messages until _done.
        ' Without DoEvents the UI would freeze and clicks would not arrive.
        Do While Not _done
            System.Windows.Forms.Application.DoEvents()
        Loop

        _interact.Stop()
        ' Success only when all three results are set (Esc clears preview, leaves nulls).
        Return SelectedView IsNot Nothing AndAlso Point1 IsNot Nothing AndAlso Point2 IsNot Nothing
    End Function

    Private Sub _mouse_OnMouseClick(Button As MouseButtonEnum, ShiftKeys As ShiftStateEnum, ModelPosition As Inventor.Point, ViewPosition As Point2d, ByVal InvView As Inventor.View) Handles _mouse.OnMouseClick
        ' Only left button advances the workflow.
        If Button <> MouseButtonEnum.kLeftMouseButton Then Return

        ' ModelPosition is sheet space for drawing interaction (X/Y in cm).
        Dim pt As Point2d = _app.TransientGeometry.CreatePoint2d(ModelPosition.X, ModelPosition.Y)

        If _step = 1 Then
            ' ----- CLICK 1: pick view + arrow tip, build note text -----
            Dim oView As DrawingView = FindViewAtPoint(DrawDoc.ActiveSheet, pt)
            If oView Is Nothing Then
                MsgBox("Click inside a drawing view.", MsgBoxStyle.Exclamation, "Thickness indicator")
                Return
            End If

            ' View must point at a Part document (.ipt), not Assembly / Drawing.
            Dim oModel As Inventor.Document = oView.ReferencedDocumentDescriptor.ReferencedDocument
            If oModel Is Nothing OrElse oModel.DocumentType <> DocumentTypeEnum.kPartDocumentObject Then
                MsgBox("View must reference a part (.ipt).", MsgBoxStyle.Exclamation, "Thickness indicator")
                Return
            End If

            SelectedView = oView
            Point2 = pt
            _noteText = BuildThicknessFormattedText(CType(oModel, PartDocument), oView)
            _step = 2
            _interact.StatusBarText = "Click 2/2: text position (Esc = cancel)"
            ' First preview: text and arrow at the same point until mouse moves.
            ShowPreview(pt)
        Else
            ' ----- CLICK 2: lock text position; keep preview as the real note -----
            Point1 = pt
            ShowPreview(pt)
            ' Drop our reference without Delete - note stays on the sheet.
            _previewLeader = Nothing
            _done = True
        End If
    End Sub

    Private Sub _mouse_OnMouseMove(Button As MouseButtonEnum, ShiftKeys As ShiftStateEnum, ModelPosition As Inventor.Point, ViewPosition As Point2d, ByVal InvView As Inventor.View) Handles _mouse.OnMouseMove
        ' Live preview only after click 1 (arrow tip Point2 already known).
        If _step <> 2 OrElse Point2 Is Nothing Then Return
        ShowPreview(_app.TransientGeometry.CreatePoint2d(ModelPosition.X, ModelPosition.Y))
    End Sub

    Private Sub _interact_OnTerminate() Handles _interact.OnTerminate
        ' Esc / cancel / interaction ended before click 2.
        ' If we never finished, remove the temporary preview leader.
        If Not _done Then ClearPreview()
        _done = True
    End Sub

    Private Sub ShowPreview(textPt As Point2d)
        ' Rebuild LeaderNote at textPt -> Point2 (arrow).
        ' Skip moves smaller than 0.05 cm to avoid delete/add every pixel.
        If _hasPreviewPos AndAlso _
           Math.Abs(_lastPreviewX - textPt.X) < 0.05 AndAlso _
           Math.Abs(_lastPreviewY - textPt.Y) < 0.05 Then Return

        ClearPreview()

        ' LeaderNotes.Add expects: first point = text, last point = arrow tip.
        Dim oLeaderPts As ObjectCollection = _app.TransientObjects.CreateObjectCollection
        oLeaderPts.Add(textPt)
        oLeaderPts.Add(Point2)
        _previewLeader = DrawDoc.ActiveSheet.DrawingNotes.LeaderNotes.Add(oLeaderPts, "")
        ' FormattedText can be plain string or Inventor XML with <Parameter>.
        _previewLeader.FormattedText = _noteText
        ' Small dot arrowhead (less visual clutter than a filled arrow).
        _previewLeader.Leader.ArrowheadType = ArrowheadTypeEnum.kSmallDotArrowheadType

        _lastPreviewX = textPt.X
        _lastPreviewY = textPt.Y
        _hasPreviewPos = True
        DrawDoc.Update()
    End Sub

    Private Sub ClearPreview()
        ' Delete temporary leader if it still exists on the sheet.
        If _previewLeader Is Nothing Then Return
        Try
            _previewLeader.Delete()
        Catch
            ' Ignore if already deleted by the user / Inventor.
        End Try
        _previewLeader = Nothing
        _hasPreviewPos = False
    End Sub

    Private Function FindViewAtPoint(oSheet As Sheet, pt As Point2d) As DrawingView
        ' Hit-test: which DrawingView rectangle contains the sheet point (cm).
        ' Walk from last to first so the top-most (later) view wins when stacked.
        For i As Integer = oSheet.DrawingViews.Count To 1 Step -1
            Dim oView As DrawingView = oSheet.DrawingViews.Item(i)
            Dim pos As Point2d = oView.Position
            Dim halfW As Double = oView.Width / 2.0
            Dim halfH As Double = oView.Height / 2.0
            If pt.X >= pos.X - halfW AndAlso pt.X <= pos.X + halfW AndAlso _
               pt.Y >= pos.Y - halfH AndAlso pt.Y <= pos.Y + halfH Then
                Return oView
            End If
        Next
        Return Nothing
    End Function

    Private Function BuildThicknessFormattedText(oPart As PartDocument, oView As DrawingView) As String
        ' Build the LeaderNote string: "x" + value, optionally linked to Thickness.
        Dim thicknessParam As Parameter = Nothing
        ' Inventor Parameter.Value for length is cm. Fallback 1.5 mm = 0.15 cm.
        Dim thicknessInventorCm As Double = 0.15

        Dim cd As ComponentDefinition = oPart.ComponentDefinition
        If TypeOf cd Is SheetMetalComponentDefinition Then
            ' Sheet metal: Thickness is a first-class property (always present).
            thicknessParam = CType(cd, SheetMetalComponentDefinition).Thickness
            thicknessInventorCm = thicknessParam.Value
        Else
            ' Regular part: only if a UserParameter named "Thickness" exists.
            Try
                thicknessParam = oPart.ComponentDefinition.Parameters.UserParameters.Item("Thickness")
                thicknessInventorCm = thicknessParam.Value
            Catch
                ' Keep fallback 0.15 cm; thicknessParam stays Nothing -> plain text.
            End Try
        End If

        ' Display mm = cm * 10; format uses NumberFormat + decimal comma.
        Dim displayValue As String = FormatThicknessForDrawing(thicknessInventorCm * 10.0)

        If thicknessParam Is Nothing Then
            ' No model link - static text only (will not update if thickness changes).
            Return "x" & displayValue
        End If

        ' ComponentIdentifier: path Inventor uses to resolve the parameter later.
        Dim componentId As String = oPart.FullFileName
        If String.IsNullOrEmpty(componentId) Then
            ' Unsaved part - fall back to the view descriptor document name.
            componentId = oView.ReferencedDocumentDescriptor.FullDocumentName
        End If

        ' Linked FormattedText XML: Inventor refreshes the number when Thickness changes.
        ' Precision='3' = up to 3 digits after decimal in the linked display.
        Return "x<Parameter Resolved='True' ComponentIdentifier='" & EscapeXmlAttribute(componentId) & _
               "' Name='" & EscapeXmlAttribute(thicknessParam.Name) & _
               "' Precision='3'>" & displayValue & "</Parameter>"
    End Function

    Private Function EscapeXmlAttribute(value As String) As String
        ' FormattedText attributes use single quotes - escape ' inside paths/names.
        If String.IsNullOrEmpty(value) Then Return ""
        Return value.Replace("'"c, "&apos;")
    End Function

    Private Function FormatThicknessForDrawing(valueMm As Double) As String
        ' 1) Format with .NET pattern from Main (CfgThicknessNumberFormat).
        ' 2) Replace "." with "," for Polish drawing convention.
        Dim fmt As String = NumberFormat
        If String.IsNullOrEmpty(fmt) Then fmt = "0.###"
        Return valueMm.ToString(fmt, Globalization.CultureInfo.InvariantCulture).Replace("."c, ","c)
    End Function
End Class

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.

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

Inventor · iLogic · 2 days ago

Export (PDF, DXF, STL, CSV)

This macro allows you to save a file with a single click in various formats, including PDF, STL, DXF, and Excel spreadsheets (CSV). The exported file formats and operating methods can be configured in the settings. Older files can be automatically moved to the OLD folder.

  • Export
  • PDF
  • DXF
  • STL
  • Exel
iLogic
'==============================================================================
' Save.iLogicVb - Autodesk Inventor iLogic export rule (single file)
' Port of ExportTools.bas (SolidWorks VBA) to Inventor iLogic / VB.NET
'
' WHAT THIS RULE DOES
'   Exports the active document next to the model file:
'     PDF, DXF (sheet-metal flat / drawing), STL, CSV (drawing Parts List / BOM).
'   Before overwriting an existing export, the old file is moved/copied into
'   a subfolder named "old\" with a timestamp from LastWriteTime.
'
' HOW TO USE
'   1) Edit the SETTINGS functions below (True/False and mode numbers).
'   2) In Inventor: External Rules -> Add Rule -> select this .iLogicVb
'      (prefer a local folder like AppData\Local\InventorRules, not W:\ / OneDrive).
'   3) The active document must already be saved on disk (needs a real path).
'
' RETURN CONTRACT (each Export* function)
'   "" (empty string) = success (OK)
'   any other string  = failure detail shown in the summary MsgBox
'
' TYPICAL FLOW FOR ONE FORMAT
'   BuildExportPath -> ArchiveToOld (if file exists) -> write new file
'
' NOTES FOR BEGINNERS
'   - iLogic uses VB.NET (not VBA). Sub Main must come first in the rule.
'   - Do NOT put Dim / Const / Shared fields above Main - iLogic will not compile.
'     Settings are Functions that Return a value (same idea as VBA Const).
'   - ThisApplication is given by iLogic (no GetObject like in SolidWorks VBA).
'   - Primary write: Document.SaveAs(path, True). Fallback: TranslatorAddIn.
'   - Sheet-metal DXF: FlatPattern DataIO (not a normal 3D SaveAs).
'     Bend centerlines are dashed (LineType 37634). CfgDxfBendDashScale sets
'     DXF header $LTSCALE so dashes are visible in CAM. Unfold uses A-Side if set.
'   - Drawing DXF: one file per sheet. Names use English index only: _sht1, _sht2.
'     If Inventor also writes a localized name (*_Arkusz_*), we keep only _shtN.dxf.
'   - Drawing BOM: CSV (; separator, UTF-8 BOM) so Excel can open it.
'     Runs only on a drawing that already has a Parts List; otherwise skipped.
'   - Small helpers (IsPart, IsBlank, RequireArchive, ...) are "syntactic sugar":
'     same logic, shorter and easier to read at call sites.
'==============================================================================

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

Sub Main()
    ' fail: 0 = all OK so far, 1 = at least one mode failed
    ' msg:  multi-line summary text for the final MsgBox ("PDF: OK", ...)
    Dim fail As Integer = 0
    Dim msg As String = ""

    ' Active document in Inventor (Part .ipt / Assembly .iam / Drawing .idw)
    Dim oDoc As Document = ThisApplication.ActiveDocument

    If oDoc Is Nothing Then
        MsgErr("No active document.")
        Return
    End If
    ' Export needs a real folder on disk - unsaved docs have empty FullFileName
    If Not HasSavedPath(oDoc) Then
        MsgErr("Document must be saved before export.")
        Return
    End If

    ' Each mode: Cfg* = user on/off switch; CanExport* = document-type gate (silent skip)
    If CfgExportPdf() Then RunMode("PDF", ExportPdf(oDoc), fail, msg)
    If CfgExportDxf() AndAlso CanExportDxf(oDoc) Then RunMode("DXF", ExportDxf(oDoc), fail, msg)
    If CfgExportStl() AndAlso CanExportStl(oDoc) Then RunMode("STL", ExportStl(oDoc), fail, msg)
    ' Excel/CSV only when drawing has Parts List (BOM) - no FAIL on Part/Assembly
    If CfgExportExcel() AndAlso CanExportExcel(oDoc) Then RunMode("Excel", ExportExcel(oDoc), fail, msg)

    ShowSummary(fail, msg)
End Sub

'----- SETTINGS (edit return values) ------------------------------------------
' Turn each export mode on/off. Only enabled modes run from Main().
' Change the Return value, then save the rule and run again.
' Implemented as Functions: iLogic forbids module-level Const/fields.

Function CfgExportPdf() As Boolean
    ' True  = export PDF of the active document (Part / Assembly / Drawing).
    Return True
End Function

Function CfgExportDxf() As Boolean
    ' True  = export DXF.
    ' Allowed only for: sheet-metal Part (flat pattern) OR Drawing.
    ' Drawing with N sheets -> N DXF files (one per sheet).
    Return True
End Function

Function CfgExportStl() As Boolean
    ' True  = export STL.
    ' Allowed only for: Part OR Assembly (not Drawing).
    Return True
End Function

Function CfgExportExcel() As Boolean
    ' True  = dump drawing Parts List (BOM) into a .csv file (opens in Excel).
    ' Runs only when CanExportExcel: Drawing + at least one PartsList.
    ' On Part/Assembly (or drawing without BOM) the mode is skipped - no FAIL line.
    Return True
End Function

Function CfgStlAssemblyMode() As Integer
    ' How to export STL when the active document is an Assembly:
    '   1 = one combined STL file (assembly as a single mesh)
    '   2 = separate STL per leaf Part component
    '       naming: "<asmBase> - <compBase>.stl"
    '   3 = both (1 then 2)
    ' Ignored for Parts (always one file).
    Return 3
End Function

Function CfgDxfAddThickness() As Boolean
    ' True  = for sheet-metal Part DXF, append thickness to the file name:
    '         e.g. "Bracket (S 2 mm).dxf"
    ' Thickness from SheetMetalComponentDefinition.Thickness (cm -> mm, *10).
    Return True
End Function

Function CfgRemoveSpaces() As Boolean
    ' True  = normalize EVERY export file name:
    '         spaces -> underscore "_", and entire name to lowercase.
    '         Example: "My Part (S 2 mm).dxf" -> "my_part_(s_2_mm).dxf"
    Return True
End Function

Function CfgNotify() As Integer
    ' 0 = show MsgBox only when something failed
    ' 1 = always show a summary MsgBox (OK/FAIL per mode)
    Return 1
End Function

Function CfgDxfBendDashScale() As Double
    ' Sheet-metal DXF only: scale of dashed bend lines ($LTSCALE in DXF header).
    ' Inventor default dashes look tiny in many CAM viewers.
    '   1  = Inventor default
    '   10 = good starting value (current)
    '   15..20 = even longer dashes - raise here if still too small
    Return 10.0
End Function

'----- TRANSLATOR GUIDS (usually do not edit) ---------------------------------
' Official Autodesk Translator Add-In IDs used by SaveViaTranslator.

Function GuidPdf() As String
    Return "{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}"
End Function

Function GuidDxf() As String
    ' Official Autodesk DXF Translator sample GUID (...CD80, not CD87).
    Return "{C24E3AC4-122E-11D5-8E91-0010B541CD80}"
End Function

Function GuidStl() As String
    Return "{533E9A98-FC3B-11D4-8E7E-0010B541CD87}"
End Function

Function DxfFlatFormat() As String
    ' Format string for sheet-metal flat pattern DXF via DataIO.WriteDataToFile.
    '
    ' KEEP visible (manufacturing geometry):
    '   IV_OUTER_PROFILE      - outer material edge (solid body for CAM)
    '   IV_INTERIOR_PROFILES  - holes / cutouts / chamfer openings (material edges)
    '   IV_BEND / IV_BEND_DOWN - bend CENTERLINES only (where the brake applies)
    '                          LineType 37634 = kDashedLineType (dashed)
    '                          BendLayer* = legacy name; BendUp/Down = modern names
    '
    ' HIDE (InvisibleLayers):
    '   IV_ARC_CENTERS         - no circle/arc center marks
    '   IV_TANGENT             - bend EXTENT / plane-boundary lines (not wanted)
    '   IV_FEATURE_PROFILES*   - extra feature edges (incl. chamfer cosmetics)
    '   IV_TOOL_CENTER*        - punch/tool centers
    '   IV_ALTREP_*            - alternate representations
    '   IV_UNCONSUMED_SKETCH*  - leftover sketches
    '   IV_ROLL*               - roll lines
    '
    ' AcadVersion=2007 - better linetype mapping than R12/2000.
    ' TrimCenterlinesAtContour=True - bend centerlines stop at the outer contour.
    ' After write, ScaleDxfBendDashes() sets $LTSCALE (see CfgDxfBendDashScale).
    Return _
        "FLAT PATTERN DXF?" & _
        "AcadVersion=2007" & _
        "&OuterProfileLayer=IV_OUTER_PROFILE" & _
        "&InteriorProfilesLayer=IV_INTERIOR_PROFILES" & _
        "&BendLayer=IV_BEND&BendLayerLineType=37634" & _
        "&BendUpLayer=IV_BEND&BendUpLayerLineType=37634" & _
        "&BendDownLayer=IV_BEND_DOWN&BendDownLayerLineType=37634" & _
        "&TrimCenterlinesAtContour=True&SimplifySplines=True&MergeProfilesIntoPolyline=True" & _
        "&InvisibleLayers=IV_ARC_CENTERS;IV_TANGENT;IV_FEATURE_PROFILES;IV_FEATURE_PROFILES_DOWN;" & _
            "IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN;IV_ALTREP_FRONT;IV_ALTREP_BACK;" & _
            "IV_UNCONSUMED_SKETCHES;IV_UNCONSUMED_SKETCH_CONSTRUCTION;IV_ROLL;IV_ROLL_TANGENT"
End Function

'===== SYNTACTIC SUGAR ========================================================
' Tiny wrappers so call sites read like English.
' They do not change Inventor behavior - only make the code easier to scan.

Function IsBlank(s As String) As Boolean
    ' True when string is Nothing or "".
    Return String.IsNullOrEmpty(s)
End Function

Function IsPart(oDoc As Document) As Boolean
    ' True for .ipt documents.
    Return oDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject
End Function

Function IsAssembly(oDoc As Document) As Boolean
    ' True for .iam documents.
    Return oDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject
End Function

Function IsDrawing(oDoc As Document) As Boolean
    ' True for .idw / .dwg drawing documents.
    Return oDoc.DocumentType = DocumentTypeEnum.kDrawingDocumentObject
End Function

Function HasSavedPath(oDoc As Document) As Boolean
    ' False for brand-new unsaved documents (no folder to export next to).
    Return Not IsBlank(oDoc.FullFileName)
End Function

Function FileExists(path As String) As Boolean
    ' Short wrapper - easier to read than System.IO.File.Exists everywhere.
    Return System.IO.File.Exists(path)
End Function

Function AsDrawing(oDoc As Document) As DrawingDocument
    ' Cast Document -> DrawingDocument (call only when IsDrawing is True).
    Return CType(oDoc, DrawingDocument)
End Function

Function AsAssembly(oDoc As Document) As AssemblyDocument
    ' Cast Document -> AssemblyDocument (call only when IsAssembly is True).
    Return CType(oDoc, AssemblyDocument)
End Function

Function AsPart(oDoc As Document) As PartDocument
    ' Cast Document -> PartDocument (call only when IsPart is True).
    Return CType(oDoc, PartDocument)
End Function

Function IsFail(result As String) As Boolean
    ' True when Export* returned a non-empty string (= failure detail).
    Return Not IsBlank(result)
End Function

Function ConfirmWritten(path As String, missingMsg As String) As String
    ' After a write attempt: "" if file exists on disk, otherwise missingMsg.
    If FileExists(path) Then Return ""
    Return missingMsg
End Function

Function RequireArchive(path As String) As String
    ' Move/copy any existing target into old\ before writing a new file.
    ' Returns "" on success, or a failure reason string.
    If ArchiveToOld(path) Then Return ""
    Return "failed to archive into old\"
End Function

Function JoinDetails(a As String, b As String) As String
    ' Merge two failure strings. Empty side is ignored (that step was OK).
    If IsBlank(a) Then Return b
    If IsBlank(b) Then Return a
    Return a & "; " & b
End Function

Function Nz(value As String, fallback As String) As String
    ' Null/empty -> fallback (same idea as Access/VBA Nz).
    If IsBlank(value) Then Return fallback
    Return value
End Function

Function SafeSheetName(sh As Sheet) As String
    ' Sheet.Name, or "?" if the API throws.
    Try
        Return sh.Name
    Catch
        Return "?"
    End Try
End Function

Function ObjCount(collection As Object) As Integer
    ' Safe .Count for late-bound Inventor collections (0 on error).
    Try
        Return CInt(collection.Count)
    Catch
        Return 0
    End Try
End Function

'===== RESULT / UI ============================================================

Sub RunMode(label As String, result As String, ByRef fail As Integer, ByRef msg As String)
    ' Append one "LABEL: OK/FAIL" line and remember overall fail.
    ' ByRef = changes to fail/msg are visible back in Main.
    If IsFail(result) Then
        fail = 1
        msg = msg & label & ": FAIL - " & result & vbCrLf
    Else
        msg = msg & label & ": OK" & vbCrLf
    End If
End Sub

Sub ShowSummary(fail As Integer, msg As String)
    ' Nothing ran (all Cfg off, or no mode allowed for this doc type)
    If IsBlank(msg) Then
        msg = "No export modes enabled / available for this document type."
        fail = 1
    End If
    ' Show summary always (CfgNotify=1) or only when something failed
    If CfgNotify() = 1 OrElse fail <> 0 Then
        Dim icon As MsgBoxStyle = If(fail = 0, MsgBoxStyle.Information, MsgBoxStyle.Exclamation)
        MsgBox(msg.Trim(), icon, "ExportTools")
    End If
End Sub

Sub MsgErr(text As String)
    ' Simple error dialog (title matches the rule / VBA tool name).
    MsgBox(text, MsgBoxStyle.Exclamation, "ExportTools")
End Sub

'===== PATH HELPERS ===========================================================

Function DocBaseName(oDoc As Document) As String
    ' File name without folder and without extension, e.g. "Bracket".
    Return System.IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName)
End Function

Function DocFolder(oDoc As Document) As String
    ' Folder that contains the model / drawing file.
    Return System.IO.Path.GetDirectoryName(oDoc.FullFileName)
End Function

Function NormalizeFileName(fileName As String) As String
    ' Apply CfgRemoveSpaces rules to a file name (not a full path).
    If CfgRemoveSpaces() Then Return LCase(Replace(fileName, " ", "_"))
    Return fileName
End Function

Function BuildExportPath(oDoc As Document, ext As String, Optional suffix As String = "") As String
    ' Full path next to the document: <folder>\<normalizedBase><suffix>.<ext>
    ' Optional suffix example: " (S 2 mm)" for sheet-metal DXF, or "_sht1".
    Return System.IO.Path.Combine(DocFolder(oDoc), NormalizeFileName(DocBaseName(oDoc) & suffix & "." & ext))
End Function

Function ComponentStlPath(asmDoc As Document, partDoc As Document) As String
    ' Per-component STL next to the assembly, e.g. "my_asm - bracket.stl".
    Dim name As String = DocBaseName(asmDoc) & " - " & DocBaseName(partDoc) & ".stl"
    Return System.IO.Path.Combine(DocFolder(asmDoc), NormalizeFileName(name))
End Function

Function EnsureDir(dirPath As String) As Boolean
    ' Create folder if missing. Returns False only if creation fails.
    Try
        If Not System.IO.Directory.Exists(dirPath) Then System.IO.Directory.CreateDirectory(dirPath)
        Return True
    Catch
        Return False
    End Try
End Function

Function WriteUtf8BomLines(path As String, lines As List(Of String)) As String
    ' Write text file as UTF-8 with BOM so Excel recognizes Polish characters.
    Try
        System.IO.File.WriteAllLines(path, lines.ToArray(), New System.Text.UTF8Encoding(True))
        Return ConfirmWritten(path, "csv not written")
    Catch ex As Exception
        Return ex.Message
    End Try
End Function

'===== RULES (when is each mode allowed?) =====================================

Function CanExportDxf(oDoc As Document) As Boolean
    ' Drawing -> yes. Part -> only if sheet metal. Assembly -> no.
    Return IsDrawing(oDoc) OrElse (IsPart(oDoc) AndAlso IsSheetMetalPart(oDoc))
End Function

Function CanExportStl(oDoc As Document) As Boolean
    ' Part or Assembly only (drawings have no solid mesh to STL).
    Return IsPart(oDoc) OrElse IsAssembly(oDoc)
End Function

Function CanExportExcel(oDoc As Document) As Boolean
    ' Must be a drawing AND at least one sheet must contain a Parts List (BOM).
    If Not IsDrawing(oDoc) Then Return False
    Return DrawingHasPartsList(AsDrawing(oDoc))
End Function

Function DrawingHasPartsList(drw As DrawingDocument) As Boolean
    ' True if any sheet has PartsLists.Count > 0.
    Dim i As Integer
    For i = 1 To drw.Sheets.Count
        Try
            If drw.Sheets.Item(i).PartsLists.Count > 0 Then Return True
        Catch
        End Try
    Next
    Return False
End Function

Function IsSheetMetalPart(oDoc As Document) As Boolean
    ' True when ComponentDefinition is SheetMetalComponentDefinition.
    Try
        If Not IsPart(oDoc) Then Return False
        Return TypeOf AsPart(oDoc).ComponentDefinition Is SheetMetalComponentDefinition
    Catch
        Return False
    End Try
End Function

Function GetSheetMetalDef(oDoc As Document) As SheetMetalComponentDefinition
    ' Cast helper - call only after IsSheetMetalPart is True.
    Return CType(AsPart(oDoc).ComponentDefinition, SheetMetalComponentDefinition)
End Function

Function GetSheetMetalThicknessMm(oDoc As Document) As Double
    ' Inventor stores length in cm internally -> multiply by 10 to get mm.
    Try
        Return GetSheetMetalDef(oDoc).Thickness.Value * 10.0
    Catch
        Return 0
    End Try
End Function

Function DxfThicknessSuffix(oDoc As Document) As String
    ' Text glued into the DXF file name when CfgDxfAddThickness is True.
    If Not CfgDxfAddThickness() Then Return ""
    Dim thk As Double = GetSheetMetalThicknessMm(oDoc)
    If thk <= 0 Then Return ""
    Return " (S " & Format(thk, "0.##") & " mm)"
End Function

'===== CORE WRITE =============================================================
' Shared pipeline for PDF / drawing DXF / STL:
'   1) RequireArchive / ArchiveToOld if the target file already exists
'   2) Document.SaveAs(path, True)  - True = save a COPY, keep original open
'   3) If that fails -> TranslatorAddIn.SaveCopyAs (GUID for the format)

Function ExportViaSaveAs(oDoc As Document, ext As String, guid As String, Optional suffix As String = "") As String
    ' One-liner used by ExportPdf / single-file STL (not multi-sheet drawing DXF).
    Return WriteExportFile(oDoc, BuildExportPath(oDoc, ext, suffix), guid)
End Function

Function WriteExportFile(oDoc As Document, path As String, guid As String) As String
    ' Full write pipeline with archive + SaveAs + translator fallback.
    Dim arch As String = RequireArchive(path)
    If IsFail(arch) Then Return arch

    Dim detail As String = TrySaveAsCopy(oDoc, path)
    If Not IsFail(detail) Then Return ""

    ' Fallback when SaveAs is not enough for this format/document
    Dim trDetail As String = SaveViaTranslator(oDoc, guid, path)
    If Not IsFail(trDetail) Then Return ""
    Return JoinDetails(detail, trDetail)
End Function

Function TrySaveAsCopy(oDoc As Document, path As String) As String
    ' True = save a COPY; original document path stays unchanged.
    Try
        oDoc.SaveAs(path, True)
        Return ConfirmWritten(path, "SaveAs did not create file")
    Catch ex As Exception
        Return "SaveAs: " & ex.Message
    End Try
End Function

Function SaveViaTranslator(oDoc As Document, guid As String, path As String) As String
    ' Look up Inventor translator add-in by GUID, then SaveCopyAs to path.
    Dim addIn As ApplicationAddIn = Nothing
    Try
        addIn = ThisApplication.ApplicationAddIns.ItemById(guid)
    Catch ex As Exception
        Return "translator add-in missing " & guid & " - " & ex.Message
    End Try

    Dim tr As TranslatorAddIn = TryCast(addIn, TranslatorAddIn)
    If tr Is Nothing Then Return "add-in is not TranslatorAddIn"
    If Not tr.Activated Then tr.Activate()

    ' TranslationContext + DataMedium = where/how to write the file
    Dim ctx As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext()
    ctx.Type = IOMechanismEnum.kFileBrowseIOMechanism
    Dim opts As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap()
    Dim data As DataMedium = ThisApplication.TransientObjects.CreateDataMedium()
    data.FileName = path

    ' HasSaveCopyAsOptions fills default options when the translator supports them.
    ' In VB.NET the Boolean return must be assigned (cannot call as a bare statement).
    Dim unusedOpts As Boolean = tr.HasSaveCopyAsOptions(oDoc, ctx, opts)
    tr.SaveCopyAs(oDoc, ctx, opts, data)
    Return ConfirmWritten(path, "Translator did not create file")
End Function

'===== EXPORT MODES ===========================================================

Function ExportPdf(oDoc As Document) As String
    ' PDF next to the document (any type SaveAs/Translator accepts).
    Return ExportViaSaveAs(oDoc, "pdf", GuidPdf())
End Function

Function ExportDxf(oDoc As Document) As String
    ' Part (sheet metal) -> flat-pattern DataIO
    ' Drawing -> one DXF per sheet (Activate + Translator). Multi-sheet SaveAs is unreliable.
    If IsPart(oDoc) Then
        Return ExportSheetMetalDxf(oDoc, BuildExportPath(oDoc, "dxf", DxfThicknessSuffix(oDoc)))
    End If
    If IsDrawing(oDoc) Then Return ExportDrawingDxfPerSheet(oDoc)
    Return "DXF: unsupported document type"
End Function

Function ExportDrawingDxfPerSheet(oDoc As Document) As String
    ' Each sheet -> separate DXF next to the drawing.
    ' Single sheet: <base>.dxf
    ' Multi sheet:  <base>_sht1.dxf, <base>_sht2.dxf, ...
    ' English index only - never localized titles (Arkusz / Sheet / ...).
    Dim drw As DrawingDocument = AsDrawing(oDoc)
    Dim prevSheet As Sheet = Nothing
    Try : prevSheet = drw.ActiveSheet : Catch : End Try

    Dim multi As Boolean = (drw.Sheets.Count > 1)
    Dim nOk As Integer = 0
    Dim nFail As Integer = 0
    Dim lastErr As String = ""
    Dim i As Integer

    For i = 1 To drw.Sheets.Count
        Try
            ' Translator exports the ACTIVE sheet - activate each one in turn
            drw.Sheets.Item(i).Activate()

            Dim suffix As String = ""
            If multi Then suffix = "_sht" & i.ToString()

            Dim r As String = ExportOneDrawingSheetDxf(oDoc, BuildExportPath(oDoc, "dxf", suffix))
            If IsFail(r) Then
                nFail += 1
                lastErr = r
            Else
                nOk += 1
            End If
        Catch ex As Exception
            nFail += 1
            lastErr = ex.Message
        End Try
    Next

    ' Restore previously active sheet so the user is not left on the last sheet
    Try
        If Not prevSheet Is Nothing Then prevSheet.Activate()
    Catch
    End Try

    If nOk = 0 Then Return Nz(lastErr, "DXF failed for all sheets")
    If nFail > 0 Then Return "exported " & nOk.ToString() & "/" & (nOk + nFail).ToString() & " sheets - " & lastErr
    Return ""
End Function

Function ExportOneDrawingSheetDxf(oDoc As Document, path As String) As String
    ' Active sheet must already be set by caller.
    ' Archive -> Translator -> SaveAs fallback.
    ' Inventor often writes BOTH our path and an extra localized name (*_Arkusz_*).
    ' ResolveNewDxf keeps only expectedPath and deletes the duplicates.
    Dim arch As String = RequireArchive(path)
    If IsFail(arch) Then Return arch

    Dim folder As String = System.IO.Path.GetDirectoryName(path)
    ' Snapshot *.dxf before write so we can detect Inventor's real output name
    Dim before As List(Of String) = ListDxfFiles(folder)

    Dim trDetail As String = SaveViaTranslator(oDoc, GuidDxf(), path)
    If Not IsFail(ResolveNewDxf(folder, before, path)) Then Return ""

    before = ListDxfFiles(folder)
    Dim saDetail As String = TrySaveAsCopy(oDoc, path)
    If Not IsFail(ResolveNewDxf(folder, before, path)) Then Return ""

    Return JoinDetails(Nz(trDetail, "Translator did not create file"), _
                       Nz(saDetail, "SaveAs did not create file"))
End Function

Function ListDxfFiles(folder As String) As List(Of String)
    ' Snapshot of *.dxf paths in folder (for detecting Inventor's real output name).
    Dim list As New List(Of String)
    Try
        If System.IO.Directory.Exists(folder) Then list.AddRange(System.IO.Directory.GetFiles(folder, "*.dxf"))
    Catch
    End Try
    Return list
End Function

Function PathInList(list As List(Of String), path As String) As Boolean
    ' Case-insensitive path membership test.
    Dim p As String
    For Each p In list
        If String.Equals(p, path, StringComparison.OrdinalIgnoreCase) Then Return True
    Next
    Return False
End Function

Sub TryDeleteFile(path As String)
    ' Best-effort delete (ignore lock / missing file).
    Try
        If FileExists(path) Then System.IO.File.Delete(path)
    Catch
    End Try
End Sub

Sub DeleteExtraDxfNewcomers(newcomers As List(Of String), keepPath As String)
    ' Remove Inventor duplicate outputs (e.g. *_Arkusz_1.dxf), keep only keepPath.
    Dim f As String
    For Each f In newcomers
        If Not String.Equals(f, keepPath, StringComparison.OrdinalIgnoreCase) Then TryDeleteFile(f)
    Next
End Sub

Function NewestPath(paths As List(Of String)) As String
    ' Path with the newest LastWriteTime (used when Inventor invents its own DXF name).
    If paths Is Nothing OrElse paths.Count = 0 Then Return ""
    Dim best As String = paths(0)
    Dim bestTime As DateTime = System.IO.File.GetLastWriteTime(best)
    Dim i As Integer
    For i = 1 To paths.Count - 1
        Dim t As DateTime = System.IO.File.GetLastWriteTime(paths(i))
        If t > bestTime Then
            bestTime = t
            best = paths(i)
        End If
    Next
    Return best
End Function

Function ListNewDxfFiles(folder As String, before As List(Of String)) As List(Of String)
    ' Files that appeared in folder after the "before" snapshot.
    Dim newcomers As New List(Of String)
    Dim f As String
    For Each f In ListDxfFiles(folder)
        If Not PathInList(before, f) Then newcomers.Add(f)
    Next
    Return newcomers
End Function

Function ResolveNewDxf(folder As String, before As List(Of String), expectedPath As String) As String
    ' Keep only expectedPath. Inventor may create expectedPath AND/OR a localized
    ' duplicate (*_Arkusz_* / *_Sheet_*). Rename if needed, then delete extras.
    Dim newcomers As List(Of String) = ListNewDxfFiles(folder, before)

    If FileExists(expectedPath) Then
        DeleteExtraDxfNewcomers(newcomers, expectedPath)
        Return ""
    End If
    If newcomers.Count = 0 Then Return "DXF file not found after export"

    Dim best As String = NewestPath(newcomers)
    If IsBlank(best) Then Return "DXF file not found after export"

    Try
        TryDeleteFile(expectedPath)
        System.IO.File.Move(best, expectedPath)
    Catch ex As Exception
        If FileExists(best) Then
            ' Could not rename - still drop other extras, keep Inventor file as last resort
            DeleteExtraDxfNewcomers(newcomers, best)
            Return ""
        End If
        Return "DXF rename failed: " & ex.Message
    End Try

    ' Drop any other newcomers left behind after the move
    newcomers = ListNewDxfFiles(folder, before)
    Dim f As String
    Dim extras As New List(Of String)
    For Each f In newcomers
        If Not String.Equals(f, expectedPath, StringComparison.OrdinalIgnoreCase) Then extras.Add(f)
    Next
    DeleteExtraDxfNewcomers(extras, expectedPath)
    Return ConfirmWritten(expectedPath, "DXF file not found after export")
End Function

Function ExportSheetMetalDxf(oDoc As Document, path As String) As String
    ' Unfold / edit flat pattern, write DXF with DataIO format string,
    ' then enlarge bend dash pattern for CAM viewers.
    Dim arch As String = RequireArchive(path)
    If IsFail(arch) Then Return arch

    Dim sm As SheetMetalComponentDefinition = Nothing
    Try
        sm = GetSheetMetalDef(oDoc)
        PrepareFlatPattern(sm)
        ' DataIO writes layers/linetypes from DxfFlatFormat()
        sm.DataIO.WriteDataToFile(DxfFlatFormat(), path)
        TryExitFlatEdit(sm)

        Dim written As String = ConfirmWritten(path, "DXF flat - no file after WriteDataToFile")
        If IsFail(written) Then Return written

        ' Inventor dashed bends are often too fine - patch DXF header $LTSCALE
        ScaleDxfBendDashes(path, CfgDxfBendDashScale())
        Return ""
    Catch ex As Exception
        TryExitFlatEdit(sm)
        Return "DXF flat: " & ex.Message
    End Try
End Function

Sub PrepareFlatPattern(sm As SheetMetalComponentDefinition)
    ' Create flat pattern if missing; otherwise enter edit for DataIO context.
    ' Unfold() uses the part A-Side definition when it is already set in Inventor
    ' (plane A facing up for manufacturing).
    If Not sm.HasFlatPattern Then
        sm.Unfold()
    Else
        sm.FlatPattern.Edit()
    End If
End Sub

Sub TryExitFlatEdit(sm As SheetMetalComponentDefinition)
    ' Always leave flat-pattern edit mode, even after an error.
    If sm Is Nothing Then Return
    Try
        If sm.HasFlatPattern Then sm.FlatPattern.ExitEdit()
    Catch
    End Try
End Sub

Sub ScaleDxfBendDashes(dxfPath As String, scale As Double)
    ' Set DXF header $LTSCALE so dashed bend lines render with longer dashes.
    ' DXF stores settings as code/value pairs (group codes). Example:
    '   9
    '   $LTSCALE
    '   40
    '   10.0
    ' Encoding ISO-8859-1 keeps Inventor byte values (PL linetype names stay intact).
    If IsBlank(dxfPath) OrElse Not FileExists(dxfPath) OrElse scale <= 0 Then Return

    Dim enc As System.Text.Encoding = System.Text.Encoding.GetEncoding("ISO-8859-1")
    Dim lines As New List(Of String)
    lines.AddRange(System.IO.File.ReadAllLines(dxfPath, enc))
    If lines.Count < 8 Then Return

    Dim scaleText As String = scale.ToString(System.Globalization.CultureInfo.InvariantCulture)
    Dim i As Integer
    Dim found As Boolean = False

    ' Case 1: $LTSCALE already exists - overwrite its numeric value (group 40)
    For i = 0 To lines.Count - 2
        If lines(i).Trim() = "9" AndAlso lines(i + 1).Trim().ToUpperInvariant() = "$LTSCALE" Then
            Dim j As Integer
            Dim jMax As Integer = i + 6
            If jMax > lines.Count - 2 Then jMax = lines.Count - 2
            For j = i + 2 To jMax Step 2
                If lines(j).Trim() = "40" Then
                    lines(j + 1) = scaleText
                    found = True
                    Exit For
                End If
            Next
            Exit For
        End If
    Next

    ' Case 2: missing - insert before first ENDSEC (end of HEADER in Inventor flat DXF)
    If Not found Then
        For i = 0 To lines.Count - 2
            If lines(i).Trim() = "0" AndAlso lines(i + 1).Trim().ToUpperInvariant() = "ENDSEC" Then
                lines.Insert(i, scaleText)
                lines.Insert(i, " 40")
                lines.Insert(i, "$LTSCALE")
                lines.Insert(i, "  9")
                found = True
                Exit For
            End If
        Next
    End If

    If found Then System.IO.File.WriteAllLines(dxfPath, lines.ToArray(), enc)
End Sub

Function ExportStl(oDoc As Document) As String
    ' Single part -> always one STL file
    If IsPart(oDoc) Then Return ExportViaSaveAs(oDoc, "stl", GuidStl())

    ' Assembly -> depend on CfgStlAssemblyMode (1 / 2 / 3)
    Dim path As String = BuildExportPath(oDoc, "stl")
    Select Case CfgStlAssemblyMode()
        Case 1
            Return WriteExportFile(oDoc, path, GuidStl())
        Case 2
            Return StlAssemblyPerComponent(oDoc)
        Case 3
            ' Run both; JoinDetails keeps OK empty and merges any errors
            Return JoinDetails(WriteExportFile(oDoc, path, GuidStl()), StlAssemblyPerComponent(oDoc))
        Case Else
            Return "invalid CfgStlAssemblyMode"
    End Select
End Function

Function StlAssemblyPerComponent(oDoc As Document) As String
    ' One STL per leaf Part occurrence.
    ' Skips suppressed components, non-Part docs, and unsaved references.
    Dim nOk As Integer = 0
    Dim lastErr As String = ""
    Try
        Dim occ As ComponentOccurrence
        For Each occ In AsAssembly(oDoc).ComponentDefinition.Occurrences.AllLeafOccurrences
            If occ.Suppressed Then Continue For

            Dim refDoc As Document = TryGetOccurrencePart(occ)
            If refDoc Is Nothing Then Continue For

            Dim r As String = WriteExportFile(refDoc, ComponentStlPath(oDoc, refDoc), GuidStl())
            If IsFail(r) Then
                lastErr = r
            Else
                nOk += 1
            End If
        Next

        If nOk = 0 AndAlso IsBlank(lastErr) Then Return "no Part components"
        Return lastErr
    Catch ex As Exception
        Return ex.Message
    End Try
End Function

Function TryGetOccurrencePart(occ As ComponentOccurrence) As Document
    ' Return the Part document behind an occurrence, or Nothing if not usable.
    Try
        Dim refDoc As Document = occ.Definition.Document
        If refDoc Is Nothing OrElse Not IsPart(refDoc) OrElse Not HasSavedPath(refDoc) Then Return Nothing
        Return refDoc
    Catch
        Return Nothing
    End Try
End Function

Function ExportExcel(oDoc As Document) As String
    ' Dump Parts List (BOM) rows to CSV next to the drawing.
    ' No Excel.Application - COM SaveAs was unreliable; CSV opens in Excel.
    Dim path As String = BuildExportPath(oDoc, "csv")
    Dim arch As String = RequireArchive(path)
    If IsFail(arch) Then Return arch

    Try
        Dim lines As List(Of String) = CollectBomCsvLines(AsDrawing(oDoc))
        If lines.Count = 0 Then Return "no Parts List (BOM) on drawing"
        Return WriteUtf8BomLines(path, lines)
    Catch ex As Exception
        Return ex.Message
    End Try
End Function

Function CollectBomCsvLines(drw As DrawingDocument) As List(Of String)
    ' Walk all sheets; dump every PartsList into CSV lines.
    Dim lines As New List(Of String)
    Dim i As Integer
    For i = 1 To drw.Sheets.Count
        Try
            Dim sh As Sheet = drw.Sheets.Item(i)
            Dim pl As PartsList
            For Each pl In sh.PartsLists
                DumpPartsListCsv(pl, SafeSheetName(sh), lines)
            Next
        Catch
        End Try
    Next
    Return lines
End Function

'===== CSV TABLES =============================================================
' Only Parts List (BOM). Custom / revision / hole / bend tables are ignored.
' Separator is ";" (Polish Excel default).

Function CsvEscape(value As String) As String
    ' Make a cell safe for semicolon-separated CSV.
    If value Is Nothing Then value = ""
    value = value.Replace(vbCrLf, " ").Replace(vbCr, " ").Replace(vbLf, " ")
    If value.Contains(";") OrElse value.Contains(""""c) OrElse value.Contains(",") Then
        Return """" & value.Replace("""", """""") & """"
    End If
    Return value
End Function

Function CsvJoin(cells As List(Of String)) As String
    ' Join one CSV row with ";" between cells.
    Dim i As Integer
    Dim sb As New System.Text.StringBuilder()
    For i = 0 To cells.Count - 1
        If i > 0 Then sb.Append(";"c)
        sb.Append(CsvEscape(cells(i)))
    Next
    Return sb.ToString()
End Function

Function CellText(cell As Object) As String
    ' Prefer .Text; fall back to .Value (PartsList cells often use Value).
    Try
        Return CStr(cell.Text)
    Catch
        Try
            Return CStr(cell.Value)
        Catch
            Return ""
        End Try
    End Try
End Function

Function ColumnTitles(cols As Object) As List(Of String)
    ' Read header titles from a PartsListColumns collection.
    Dim c As Integer
    Dim header As New List(Of String)
    For c = 1 To ObjCount(cols)
        Try
            header.Add(CStr(cols.Item(c).Title))
        Catch
            header.Add("")
        End Try
    Next
    Return header
End Function

Function RowCells(rowObj As Object, colCount As Integer) As List(Of String)
    ' Read one data row as a list of cell strings.
    Dim c As Integer
    Dim data As New List(Of String)
    For c = 1 To colCount
        Try
            data.Add(CellText(rowObj.Item(c)))
        Catch
            data.Add("")
        End Try
    Next
    Return data
End Function

Function RowIsHidden(rowObj As Object) As Boolean
    ' PartsList rows can be invisible; skip them when dumping BOM.
    Try
        Return rowObj.Visible = False
    Catch
        Return False
    End Try
End Function

Sub DumpPartsListCsv(pl As PartsList, sheetLabel As String, lines As List(Of String))
    ' Write: title line -> header row -> data rows -> blank separator line.
    ' PartsList uses PartsListColumns / PartsListRows (not generic Rows/Columns).
    Dim title As String = ""
    Try : title = pl.Title : Catch : End Try

    Dim cols As Object = pl.PartsListColumns
    Dim rows As Object = pl.PartsListRows
    Dim colCount As Integer = ObjCount(cols)
    If colCount <= 0 Then Return

    lines.Add(CsvEscape("[" & sheetLabel & "] " & Nz(title, "Parts List")))
    lines.Add(CsvJoin(ColumnTitles(cols)))

    Dim r As Integer
    For r = 1 To ObjCount(rows)
        Dim rowObj As Object = rows.Item(r)
        If RowIsHidden(rowObj) Then Continue For
        lines.Add(CsvJoin(RowCells(rowObj, colCount)))
    Next
    lines.Add("")
End Sub

'===== ARCHIVE ================================================================
' If finalPath already exists: move/copy into
'   old\<base>_<yyyyMMdd.HHmmss>.<ext>
' Prefer Move; if the file is locked, try Copy (same idea as VBA ArchiveToOld).

Function ArchiveToOld(finalPath As String) As Boolean
    Try
        If IsBlank(finalPath) Then Return True

        finalPath = System.IO.Path.GetFullPath(finalPath)
        ' Nothing to archive - first export of this name
        If Not FileExists(finalPath) Then Return True

        Dim oldDir As String = System.IO.Path.Combine(System.IO.Path.GetDirectoryName(finalPath), "old")
        If Not EnsureDir(oldDir) Then
            MsgErr("Failed to archive into old\:" & vbCrLf & finalPath)
            Return False
        End If

        Dim dest As String = UniqueArchivePath(finalPath, oldDir)
        If TryMoveFile(finalPath, dest) Then Return True
        ' Fallback when Move fails (file open elsewhere, permissions, etc.)
        If TryCopyFile(finalPath, dest) Then Return True

        MsgErr("Failed to archive into old\:" & vbCrLf & finalPath)
        Return False
    Catch
        MsgErr("Failed to archive into old\:" & vbCrLf & finalPath)
        Return False
    End Try
End Function

Function UniqueArchivePath(finalPath As String, oldDir As String) As String
    ' Build old\<base>_<stamp>.ext ; add _2, _3... if that name already exists.
    Dim baseName As String = System.IO.Path.GetFileNameWithoutExtension(finalPath)
    Dim ext As String = System.IO.Path.GetExtension(finalPath)
    If ext.StartsWith(".") Then ext = ext.Substring(1)

    ' Stamp from the existing file's last write time
    Dim stamp As String = System.IO.File.GetLastWriteTime(finalPath).ToString("yyyyMMdd.HHmmss")
    Dim dest As String = System.IO.Path.Combine(oldDir, baseName & "_" & stamp & "." & ext)
    Dim n As Integer = 2
    Do While FileExists(dest)
        dest = System.IO.Path.Combine(oldDir, baseName & "_" & stamp & "_" & n & "." & ext)
        n += 1
    Loop
    Return dest
End Function

Function TryMoveFile(source As String, dest As String) As Boolean
    ' Prefer Move so the old file does not stay in the export folder.
    Try
        System.IO.File.Move(source, dest)
        Return FileExists(dest) AndAlso Not FileExists(source)
    Catch
        Return False
    End Try
End Function

Function TryCopyFile(source As String, dest As String) As Boolean
    ' Used when Move cannot lock/replace the source file.
    Try
        System.IO.File.Copy(source, dest, True)
        Return FileExists(dest)
    Catch
        Return False
    End Try
End Function
'==============================================================================
' Save.iLogicVb - Autodesk Inventor iLogic export rule (single file)
' Port of ExportTools.bas (SolidWorks VBA) to Inventor iLogic / VB.NET
'
' WHAT THIS RULE DOES
'   Exports the active document next to the model file:
'     PDF, DXF (sheet-metal flat / drawing), STL, CSV (drawing Parts List / BOM).
'   Before overwriting an existing export, the old file is moved/copied into
'   a subfolder named "old\" with a timestamp from LastWriteTime.
'
' HOW TO USE
'   1) Edit the SETTINGS functions below (True/False and mode numbers).
'   2) In Inventor: External Rules -> Add Rule -> select this .iLogicVb
'      (prefer a local folder like AppData\Local\InventorRules, not W:\ / OneDrive).
'   3) The active document must already be saved on disk (needs a real path).
'
' RETURN CONTRACT (each Export* function)
'   "" (empty string) = success (OK)
'   any other string  = failure detail shown in the summary MsgBox
'
' TYPICAL FLOW FOR ONE FORMAT
'   BuildExportPath -> ArchiveToOld (if file exists) -> write new file
'
' NOTES FOR BEGINNERS
'   - iLogic uses VB.NET (not VBA). Sub Main must come first in the rule.
'   - Do NOT put Dim / Const / Shared fields above Main - iLogic will not compile.
'     Settings are Functions that Return a value (same idea as VBA Const).
'   - ThisApplication is given by iLogic (no GetObject like in SolidWorks VBA).
'   - Primary write: Document.SaveAs(path, True). Fallback: TranslatorAddIn.
'   - Sheet-metal DXF: FlatPattern DataIO (not a normal 3D SaveAs).
'     Bend centerlines are dashed (LineType 37634). CfgDxfBendDashScale sets
'     DXF header $LTSCALE so dashes are visible in CAM. Unfold uses A-Side if set.
'   - Drawing DXF: one file per sheet. Names use English index only: _sht1, _sht2.
'     If Inventor also writes a localized name (*_Arkusz_*), we keep only _shtN.dxf.
'   - Drawing BOM: CSV (; separator, UTF-8 BOM) so Excel can open it.
'     Runs only on a drawing that already has a Parts List; otherwise skipped.
'   - Small helpers (IsPart, IsBlank, RequireArchive, ...) are "syntactic sugar":
'     same logic, shorter and easier to read at call sites.
'==============================================================================

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

Sub Main()
    ' fail: 0 = all OK so far, 1 = at least one mode failed
    ' msg:  multi-line summary text for the final MsgBox ("PDF: OK", ...)
    Dim fail As Integer = 0
    Dim msg As String = ""

    ' Active document in Inventor (Part .ipt / Assembly .iam / Drawing .idw)
    Dim oDoc As Document = ThisApplication.ActiveDocument

    If oDoc Is Nothing Then
        MsgErr("No active document.")
        Return
    End If
    ' Export needs a real folder on disk - unsaved docs have empty FullFileName
    If Not HasSavedPath(oDoc) Then
        MsgErr("Document must be saved before export.")
        Return
    End If

    ' Each mode: Cfg* = user on/off switch; CanExport* = document-type gate (silent skip)
    If CfgExportPdf() Then RunMode("PDF", ExportPdf(oDoc), fail, msg)
    If CfgExportDxf() AndAlso CanExportDxf(oDoc) Then RunMode("DXF", ExportDxf(oDoc), fail, msg)
    If CfgExportStl() AndAlso CanExportStl(oDoc) Then RunMode("STL", ExportStl(oDoc), fail, msg)
    ' Excel/CSV only when drawing has Parts List (BOM) - no FAIL on Part/Assembly
    If CfgExportExcel() AndAlso CanExportExcel(oDoc) Then RunMode("Excel", ExportExcel(oDoc), fail, msg)

    ShowSummary(fail, msg)
End Sub

'----- SETTINGS (edit return values) ------------------------------------------
' Turn each export mode on/off. Only enabled modes run from Main().
' Change the Return value, then save the rule and run again.
' Implemented as Functions: iLogic forbids module-level Const/fields.

Function CfgExportPdf() As Boolean
    ' True  = export PDF of the active document (Part / Assembly / Drawing).
    Return True
End Function

Function CfgExportDxf() As Boolean
    ' True  = export DXF.
    ' Allowed only for: sheet-metal Part (flat pattern) OR Drawing.
    ' Drawing with N sheets -> N DXF files (one per sheet).
    Return True
End Function

Function CfgExportStl() As Boolean
    ' True  = export STL.
    ' Allowed only for: Part OR Assembly (not Drawing).
    Return True
End Function

Function CfgExportExcel() As Boolean
    ' True  = dump drawing Parts List (BOM) into a .csv file (opens in Excel).
    ' Runs only when CanExportExcel: Drawing + at least one PartsList.
    ' On Part/Assembly (or drawing without BOM) the mode is skipped - no FAIL line.
    Return True
End Function

Function CfgStlAssemblyMode() As Integer
    ' How to export STL when the active document is an Assembly:
    '   1 = one combined STL file (assembly as a single mesh)
    '   2 = separate STL per leaf Part component
    '       naming: "<asmBase> - <compBase>.stl"
    '   3 = both (1 then 2)
    ' Ignored for Parts (always one file).
    Return 3
End Function

Function CfgDxfAddThickness() As Boolean
    ' True  = for sheet-metal Part DXF, append thickness to the file name:
    '         e.g. "Bracket (S 2 mm).dxf"
    ' Thickness from SheetMetalComponentDefinition.Thickness (cm -> mm, *10).
    Return True
End Function

Function CfgRemoveSpaces() As Boolean
    ' True  = normalize EVERY export file name:
    '         spaces -> underscore "_", and entire name to lowercase.
    '         Example: "My Part (S 2 mm).dxf" -> "my_part_(s_2_mm).dxf"
    Return True
End Function

Function CfgNotify() As Integer
    ' 0 = show MsgBox only when something failed
    ' 1 = always show a summary MsgBox (OK/FAIL per mode)
    Return 1
End Function

Function CfgDxfBendDashScale() As Double
    ' Sheet-metal DXF only: scale of dashed bend lines ($LTSCALE in DXF header).
    ' Inventor default dashes look tiny in many CAM viewers.
    '   1  = Inventor default
    '   10 = good starting value (current)
    '   15..20 = even longer dashes - raise here if still too small
    Return 10.0
End Function

'----- TRANSLATOR GUIDS (usually do not edit) ---------------------------------
' Official Autodesk Translator Add-In IDs used by SaveViaTranslator.

Function GuidPdf() As String
    Return "{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}"
End Function

Function GuidDxf() As String
    ' Official Autodesk DXF Translator sample GUID (...CD80, not CD87).
    Return "{C24E3AC4-122E-11D5-8E91-0010B541CD80}"
End Function

Function GuidStl() As String
    Return "{533E9A98-FC3B-11D4-8E7E-0010B541CD87}"
End Function

Function DxfFlatFormat() As String
    ' Format string for sheet-metal flat pattern DXF via DataIO.WriteDataToFile.
    '
    ' KEEP visible (manufacturing geometry):
    '   IV_OUTER_PROFILE      - outer material edge (solid body for CAM)
    '   IV_INTERIOR_PROFILES  - holes / cutouts / chamfer openings (material edges)
    '   IV_BEND / IV_BEND_DOWN - bend CENTERLINES only (where the brake applies)
    '                          LineType 37634 = kDashedLineType (dashed)
    '                          BendLayer* = legacy name; BendUp/Down = modern names
    '
    ' HIDE (InvisibleLayers):
    '   IV_ARC_CENTERS         - no circle/arc center marks
    '   IV_TANGENT             - bend EXTENT / plane-boundary lines (not wanted)
    '   IV_FEATURE_PROFILES*   - extra feature edges (incl. chamfer cosmetics)
    '   IV_TOOL_CENTER*        - punch/tool centers
    '   IV_ALTREP_*            - alternate representations
    '   IV_UNCONSUMED_SKETCH*  - leftover sketches
    '   IV_ROLL*               - roll lines
    '
    ' AcadVersion=2007 - better linetype mapping than R12/2000.
    ' TrimCenterlinesAtContour=True - bend centerlines stop at the outer contour.
    ' After write, ScaleDxfBendDashes() sets $LTSCALE (see CfgDxfBendDashScale).
    Return _
        "FLAT PATTERN DXF?" & _
        "AcadVersion=2007" & _
        "&OuterProfileLayer=IV_OUTER_PROFILE" & _
        "&InteriorProfilesLayer=IV_INTERIOR_PROFILES" & _
        "&BendLayer=IV_BEND&BendLayerLineType=37634" & _
        "&BendUpLayer=IV_BEND&BendUpLayerLineType=37634" & _
        "&BendDownLayer=IV_BEND_DOWN&BendDownLayerLineType=37634" & _
        "&TrimCenterlinesAtContour=True&SimplifySplines=True&MergeProfilesIntoPolyline=True" & _
        "&InvisibleLayers=IV_ARC_CENTERS;IV_TANGENT;IV_FEATURE_PROFILES;IV_FEATURE_PROFILES_DOWN;" & _
            "IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN;IV_ALTREP_FRONT;IV_ALTREP_BACK;" & _
            "IV_UNCONSUMED_SKETCHES;IV_UNCONSUMED_SKETCH_CONSTRUCTION;IV_ROLL;IV_ROLL_TANGENT"
End Function

'===== SYNTACTIC SUGAR ========================================================
' Tiny wrappers so call sites read like English.
' They do not change Inventor behavior - only make the code easier to scan.

Function IsBlank(s As String) As Boolean
    ' True when string is Nothing or "".
    Return String.IsNullOrEmpty(s)
End Function

Function IsPart(oDoc As Document) As Boolean
    ' True for .ipt documents.
    Return oDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject
End Function

Function IsAssembly(oDoc As Document) As Boolean
    ' True for .iam documents.
    Return oDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject
End Function

Function IsDrawing(oDoc As Document) As Boolean
    ' True for .idw / .dwg drawing documents.
    Return oDoc.DocumentType = DocumentTypeEnum.kDrawingDocumentObject
End Function

Function HasSavedPath(oDoc As Document) As Boolean
    ' False for brand-new unsaved documents (no folder to export next to).
    Return Not IsBlank(oDoc.FullFileName)
End Function

Function FileExists(path As String) As Boolean
    ' Short wrapper - easier to read than System.IO.File.Exists everywhere.
    Return System.IO.File.Exists(path)
End Function

Function AsDrawing(oDoc As Document) As DrawingDocument
    ' Cast Document -> DrawingDocument (call only when IsDrawing is True).
    Return CType(oDoc, DrawingDocument)
End Function

Function AsAssembly(oDoc As Document) As AssemblyDocument
    ' Cast Document -> AssemblyDocument (call only when IsAssembly is True).
    Return CType(oDoc, AssemblyDocument)
End Function

Function AsPart(oDoc As Document) As PartDocument
    ' Cast Document -> PartDocument (call only when IsPart is True).
    Return CType(oDoc, PartDocument)
End Function

Function IsFail(result As String) As Boolean
    ' True when Export* returned a non-empty string (= failure detail).
    Return Not IsBlank(result)
End Function

Function ConfirmWritten(path As String, missingMsg As String) As String
    ' After a write attempt: "" if file exists on disk, otherwise missingMsg.
    If FileExists(path) Then Return ""
    Return missingMsg
End Function

Function RequireArchive(path As String) As String
    ' Move/copy any existing target into old\ before writing a new file.
    ' Returns "" on success, or a failure reason string.
    If ArchiveToOld(path) Then Return ""
    Return "failed to archive into old\"
End Function

Function JoinDetails(a As String, b As String) As String
    ' Merge two failure strings. Empty side is ignored (that step was OK).
    If IsBlank(a) Then Return b
    If IsBlank(b) Then Return a
    Return a & "; " & b
End Function

Function Nz(value As String, fallback As String) As String
    ' Null/empty -> fallback (same idea as Access/VBA Nz).
    If IsBlank(value) Then Return fallback
    Return value
End Function

Function SafeSheetName(sh As Sheet) As String
    ' Sheet.Name, or "?" if the API throws.
    Try
        Return sh.Name
    Catch
        Return "?"
    End Try
End Function

Function ObjCount(collection As Object) As Integer
    ' Safe .Count for late-bound Inventor collections (0 on error).
    Try
        Return CInt(collection.Count)
    Catch
        Return 0
    End Try
End Function

'===== RESULT / UI ============================================================

Sub RunMode(label As String, result As String, ByRef fail As Integer, ByRef msg As String)
    ' Append one "LABEL: OK/FAIL" line and remember overall fail.
    ' ByRef = changes to fail/msg are visible back in Main.
    If IsFail(result) Then
        fail = 1
        msg = msg & label & ": FAIL - " & result & vbCrLf
    Else
        msg = msg & label & ": OK" & vbCrLf
    End If
End Sub

Sub ShowSummary(fail As Integer, msg As String)
    ' Nothing ran (all Cfg off, or no mode allowed for this doc type)
    If IsBlank(msg) Then
        msg = "No export modes enabled / available for this document type."
        fail = 1
    End If
    ' Show summary always (CfgNotify=1) or only when something failed
    If CfgNotify() = 1 OrElse fail <> 0 Then
        Dim icon As MsgBoxStyle = If(fail = 0, MsgBoxStyle.Information, MsgBoxStyle.Exclamation)
        MsgBox(msg.Trim(), icon, "ExportTools")
    End If
End Sub

Sub MsgErr(text As String)
    ' Simple error dialog (title matches the rule / VBA tool name).
    MsgBox(text, MsgBoxStyle.Exclamation, "ExportTools")
End Sub

'===== PATH HELPERS ===========================================================

Function DocBaseName(oDoc As Document) As String
    ' File name without folder and without extension, e.g. "Bracket".
    Return System.IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName)
End Function

Function DocFolder(oDoc As Document) As String
    ' Folder that contains the model / drawing file.
    Return System.IO.Path.GetDirectoryName(oDoc.FullFileName)
End Function

Function NormalizeFileName(fileName As String) As String
    ' Apply CfgRemoveSpaces rules to a file name (not a full path).
    If CfgRemoveSpaces() Then Return LCase(Replace(fileName, " ", "_"))
    Return fileName
End Function

Function BuildExportPath(oDoc As Document, ext As String, Optional suffix As String = "") As String
    ' Full path next to the document: <folder>\<normalizedBase><suffix>.<ext>
    ' Optional suffix example: " (S 2 mm)" for sheet-metal DXF, or "_sht1".
    Return System.IO.Path.Combine(DocFolder(oDoc), NormalizeFileName(DocBaseName(oDoc) & suffix & "." & ext))
End Function

Function ComponentStlPath(asmDoc As Document, partDoc As Document) As String
    ' Per-component STL next to the assembly, e.g. "my_asm - bracket.stl".
    Dim name As String = DocBaseName(asmDoc) & " - " & DocBaseName(partDoc) & ".stl"
    Return System.IO.Path.Combine(DocFolder(asmDoc), NormalizeFileName(name))
End Function

Function EnsureDir(dirPath As String) As Boolean
    ' Create folder if missing. Returns False only if creation fails.
    Try
        If Not System.IO.Directory.Exists(dirPath) Then System.IO.Directory.CreateDirectory(dirPath)
        Return True
    Catch
        Return False
    End Try
End Function

Function WriteUtf8BomLines(path As String, lines As List(Of String)) As String
    ' Write text file as UTF-8 with BOM so Excel recognizes Polish characters.
    Try
        System.IO.File.WriteAllLines(path, lines.ToArray(), New System.Text.UTF8Encoding(True))
        Return ConfirmWritten(path, "csv not written")
    Catch ex As Exception
        Return ex.Message
    End Try
End Function

'===== RULES (when is each mode allowed?) =====================================

Function CanExportDxf(oDoc As Document) As Boolean
    ' Drawing -> yes. Part -> only if sheet metal. Assembly -> no.
    Return IsDrawing(oDoc) OrElse (IsPart(oDoc) AndAlso IsSheetMetalPart(oDoc))
End Function

Function CanExportStl(oDoc As Document) As Boolean
    ' Part or Assembly only (drawings have no solid mesh to STL).
    Return IsPart(oDoc) OrElse IsAssembly(oDoc)
End Function

Function CanExportExcel(oDoc As Document) As Boolean
    ' Must be a drawing AND at least one sheet must contain a Parts List (BOM).
    If Not IsDrawing(oDoc) Then Return False
    Return DrawingHasPartsList(AsDrawing(oDoc))
End Function

Function DrawingHasPartsList(drw As DrawingDocument) As Boolean
    ' True if any sheet has PartsLists.Count > 0.
    Dim i As Integer
    For i = 1 To drw.Sheets.Count
        Try
            If drw.Sheets.Item(i).PartsLists.Count > 0 Then Return True
        Catch
        End Try
    Next
    Return False
End Function

Function IsSheetMetalPart(oDoc As Document) As Boolean
    ' True when ComponentDefinition is SheetMetalComponentDefinition.
    Try
        If Not IsPart(oDoc) Then Return False
        Return TypeOf AsPart(oDoc).ComponentDefinition Is SheetMetalComponentDefinition
    Catch
        Return False
    End Try
End Function

Function GetSheetMetalDef(oDoc As Document) As SheetMetalComponentDefinition
    ' Cast helper - call only after IsSheetMetalPart is True.
    Return CType(AsPart(oDoc).ComponentDefinition, SheetMetalComponentDefinition)
End Function

Function GetSheetMetalThicknessMm(oDoc As Document) As Double
    ' Inventor stores length in cm internally -> multiply by 10 to get mm.
    Try
        Return GetSheetMetalDef(oDoc).Thickness.Value * 10.0
    Catch
        Return 0
    End Try
End Function

Function DxfThicknessSuffix(oDoc As Document) As String
    ' Text glued into the DXF file name when CfgDxfAddThickness is True.
    If Not CfgDxfAddThickness() Then Return ""
    Dim thk As Double = GetSheetMetalThicknessMm(oDoc)
    If thk <= 0 Then Return ""
    Return " (S " & Format(thk, "0.##") & " mm)"
End Function

'===== CORE WRITE =============================================================
' Shared pipeline for PDF / drawing DXF / STL:
'   1) RequireArchive / ArchiveToOld if the target file already exists
'   2) Document.SaveAs(path, True)  - True = save a COPY, keep original open
'   3) If that fails -> TranslatorAddIn.SaveCopyAs (GUID for the format)

Function ExportViaSaveAs(oDoc As Document, ext As String, guid As String, Optional suffix As String = "") As String
    ' One-liner used by ExportPdf / single-file STL (not multi-sheet drawing DXF).
    Return WriteExportFile(oDoc, BuildExportPath(oDoc, ext, suffix), guid)
End Function

Function WriteExportFile(oDoc As Document, path As String, guid As String) As String
    ' Full write pipeline with archive + SaveAs + translator fallback.
    Dim arch As String = RequireArchive(path)
    If IsFail(arch) Then Return arch

    Dim detail As String = TrySaveAsCopy(oDoc, path)
    If Not IsFail(detail) Then Return ""

    ' Fallback when SaveAs is not enough for this format/document
    Dim trDetail As String = SaveViaTranslator(oDoc, guid, path)
    If Not IsFail(trDetail) Then Return ""
    Return JoinDetails(detail, trDetail)
End Function

Function TrySaveAsCopy(oDoc As Document, path As String) As String
    ' True = save a COPY; original document path stays unchanged.
    Try
        oDoc.SaveAs(path, True)
        Return ConfirmWritten(path, "SaveAs did not create file")
    Catch ex As Exception
        Return "SaveAs: " & ex.Message
    End Try
End Function

Function SaveViaTranslator(oDoc As Document, guid As String, path As String) As String
    ' Look up Inventor translator add-in by GUID, then SaveCopyAs to path.
    Dim addIn As ApplicationAddIn = Nothing
    Try
        addIn = ThisApplication.ApplicationAddIns.ItemById(guid)
    Catch ex As Exception
        Return "translator add-in missing " & guid & " - " & ex.Message
    End Try

    Dim tr As TranslatorAddIn = TryCast(addIn, TranslatorAddIn)
    If tr Is Nothing Then Return "add-in is not TranslatorAddIn"
    If Not tr.Activated Then tr.Activate()

    ' TranslationContext + DataMedium = where/how to write the file
    Dim ctx As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext()
    ctx.Type = IOMechanismEnum.kFileBrowseIOMechanism
    Dim opts As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap()
    Dim data As DataMedium = ThisApplication.TransientObjects.CreateDataMedium()
    data.FileName = path

    ' HasSaveCopyAsOptions fills default options when the translator supports them.
    ' In VB.NET the Boolean return must be assigned (cannot call as a bare statement).
    Dim unusedOpts As Boolean = tr.HasSaveCopyAsOptions(oDoc, ctx, opts)
    tr.SaveCopyAs(oDoc, ctx, opts, data)
    Return ConfirmWritten(path, "Translator did not create file")
End Function

'===== EXPORT MODES ===========================================================

Function ExportPdf(oDoc As Document) As String
    ' PDF next to the document (any type SaveAs/Translator accepts).
    Return ExportViaSaveAs(oDoc, "pdf", GuidPdf())
End Function

Function ExportDxf(oDoc As Document) As String
    ' Part (sheet metal) -> flat-pattern DataIO
    ' Drawing -> one DXF per sheet (Activate + Translator). Multi-sheet SaveAs is unreliable.
    If IsPart(oDoc) Then
        Return ExportSheetMetalDxf(oDoc, BuildExportPath(oDoc, "dxf", DxfThicknessSuffix(oDoc)))
    End If
    If IsDrawing(oDoc) Then Return ExportDrawingDxfPerSheet(oDoc)
    Return "DXF: unsupported document type"
End Function

Function ExportDrawingDxfPerSheet(oDoc As Document) As String
    ' Each sheet -> separate DXF next to the drawing.
    ' Single sheet: <base>.dxf
    ' Multi sheet:  <base>_sht1.dxf, <base>_sht2.dxf, ...
    ' English index only - never localized titles (Arkusz / Sheet / ...).
    Dim drw As DrawingDocument = AsDrawing(oDoc)
    Dim prevSheet As Sheet = Nothing
    Try : prevSheet = drw.ActiveSheet : Catch : End Try

    Dim multi As Boolean = (drw.Sheets.Count > 1)
    Dim nOk As Integer = 0
    Dim nFail As Integer = 0
    Dim lastErr As String = ""
    Dim i As Integer

    For i = 1 To drw.Sheets.Count
        Try
            ' Translator exports the ACTIVE sheet - activate each one in turn
            drw.Sheets.Item(i).Activate()

            Dim suffix As String = ""
            If multi Then suffix = "_sht" & i.ToString()

            Dim r As String = ExportOneDrawingSheetDxf(oDoc, BuildExportPath(oDoc, "dxf", suffix))
            If IsFail(r) Then
                nFail += 1
                lastErr = r
            Else
                nOk += 1
            End If
        Catch ex As Exception
            nFail += 1
            lastErr = ex.Message
        End Try
    Next

    ' Restore previously active sheet so the user is not left on the last sheet
    Try
        If Not prevSheet Is Nothing Then prevSheet.Activate()
    Catch
    End Try

    If nOk = 0 Then Return Nz(lastErr, "DXF failed for all sheets")
    If nFail > 0 Then Return "exported " & nOk.ToString() & "/" & (nOk + nFail).ToString() & " sheets - " & lastErr
    Return ""
End Function

Function ExportOneDrawingSheetDxf(oDoc As Document, path As String) As String
    ' Active sheet must already be set by caller.
    ' Archive -> Translator -> SaveAs fallback.
    ' Inventor often writes BOTH our path and an extra localized name (*_Arkusz_*).
    ' ResolveNewDxf keeps only expectedPath and deletes the duplicates.
    Dim arch As String = RequireArchive(path)
    If IsFail(arch) Then Return arch

    Dim folder As String = System.IO.Path.GetDirectoryName(path)
    ' Snapshot *.dxf before write so we can detect Inventor's real output name
    Dim before As List(Of String) = ListDxfFiles(folder)

    Dim trDetail As String = SaveViaTranslator(oDoc, GuidDxf(), path)
    If Not IsFail(ResolveNewDxf(folder, before, path)) Then Return ""

    before = ListDxfFiles(folder)
    Dim saDetail As String = TrySaveAsCopy(oDoc, path)
    If Not IsFail(ResolveNewDxf(folder, before, path)) Then Return ""

    Return JoinDetails(Nz(trDetail, "Translator did not create file"), _
                       Nz(saDetail, "SaveAs did not create file"))
End Function

Function ListDxfFiles(folder As String) As List(Of String)
    ' Snapshot of *.dxf paths in folder (for detecting Inventor's real output name).
    Dim list As New List(Of String)
    Try
        If System.IO.Directory.Exists(folder) Then list.AddRange(System.IO.Directory.GetFiles(folder, "*.dxf"))
    Catch
    End Try
    Return list
End Function

Function PathInList(list As List(Of String), path As String) As Boolean
    ' Case-insensitive path membership test.
    Dim p As String
    For Each p In list
        If String.Equals(p, path, StringComparison.OrdinalIgnoreCase) Then Return True
    Next
    Return False
End Function

Sub TryDeleteFile(path As String)
    ' Best-effort delete (ignore lock / missing file).
    Try
        If FileExists(path) Then System.IO.File.Delete(path)
    Catch
    End Try
End Sub

Sub DeleteExtraDxfNewcomers(newcomers As List(Of String), keepPath As String)
    ' Remove Inventor duplicate outputs (e.g. *_Arkusz_1.dxf), keep only keepPath.
    Dim f As String
    For Each f In newcomers
        If Not String.Equals(f, keepPath, StringComparison.OrdinalIgnoreCase) Then TryDeleteFile(f)
    Next
End Sub

Function NewestPath(paths As List(Of String)) As String
    ' Path with the newest LastWriteTime (used when Inventor invents its own DXF name).
    If paths Is Nothing OrElse paths.Count = 0 Then Return ""
    Dim best As String = paths(0)
    Dim bestTime As DateTime = System.IO.File.GetLastWriteTime(best)
    Dim i As Integer
    For i = 1 To paths.Count - 1
        Dim t As DateTime = System.IO.File.GetLastWriteTime(paths(i))
        If t > bestTime Then
            bestTime = t
            best = paths(i)
        End If
    Next
    Return best
End Function

Function ListNewDxfFiles(folder As String, before As List(Of String)) As List(Of String)
    ' Files that appeared in folder after the "before" snapshot.
    Dim newcomers As New List(Of String)
    Dim f As String
    For Each f In ListDxfFiles(folder)
        If Not PathInList(before, f) Then newcomers.Add(f)
    Next
    Return newcomers
End Function

Function ResolveNewDxf(folder As String, before As List(Of String), expectedPath As String) As String
    ' Keep only expectedPath. Inventor may create expectedPath AND/OR a localized
    ' duplicate (*_Arkusz_* / *_Sheet_*). Rename if needed, then delete extras.
    Dim newcomers As List(Of String) = ListNewDxfFiles(folder, before)

    If FileExists(expectedPath) Then
        DeleteExtraDxfNewcomers(newcomers, expectedPath)
        Return ""
    End If
    If newcomers.Count = 0 Then Return "DXF file not found after export"

    Dim best As String = NewestPath(newcomers)
    If IsBlank(best) Then Return "DXF file not found after export"

    Try
        TryDeleteFile(expectedPath)
        System.IO.File.Move(best, expectedPath)
    Catch ex As Exception
        If FileExists(best) Then
            ' Could not rename - still drop other extras, keep Inventor file as last resort
            DeleteExtraDxfNewcomers(newcomers, best)
            Return ""
        End If
        Return "DXF rename failed: " & ex.Message
    End Try

    ' Drop any other newcomers left behind after the move
    newcomers = ListNewDxfFiles(folder, before)
    Dim f As String
    Dim extras As New List(Of String)
    For Each f In newcomers
        If Not String.Equals(f, expectedPath, StringComparison.OrdinalIgnoreCase) Then extras.Add(f)
    Next
    DeleteExtraDxfNewcomers(extras, expectedPath)
    Return ConfirmWritten(expectedPath, "DXF file not found after export")
End Function

Function ExportSheetMetalDxf(oDoc As Document, path As String) As String
    ' Unfold / edit flat pattern, write DXF with DataIO format string,
    ' then enlarge bend dash pattern for CAM viewers.
    Dim arch As String = RequireArchive(path)
    If IsFail(arch) Then Return arch

    Dim sm As SheetMetalComponentDefinition = Nothing
    Try
        sm = GetSheetMetalDef(oDoc)
        PrepareFlatPattern(sm)
        ' DataIO writes layers/linetypes from DxfFlatFormat()
        sm.DataIO.WriteDataToFile(DxfFlatFormat(), path)
        TryExitFlatEdit(sm)

        Dim written As String = ConfirmWritten(path, "DXF flat - no file after WriteDataToFile")
        If IsFail(written) Then Return written

        ' Inventor dashed bends are often too fine - patch DXF header $LTSCALE
        ScaleDxfBendDashes(path, CfgDxfBendDashScale())
        Return ""
    Catch ex As Exception
        TryExitFlatEdit(sm)
        Return "DXF flat: " & ex.Message
    End Try
End Function

Sub PrepareFlatPattern(sm As SheetMetalComponentDefinition)
    ' Create flat pattern if missing; otherwise enter edit for DataIO context.
    ' Unfold() uses the part A-Side definition when it is already set in Inventor
    ' (plane A facing up for manufacturing).
    If Not sm.HasFlatPattern Then
        sm.Unfold()
    Else
        sm.FlatPattern.Edit()
    End If
End Sub

Sub TryExitFlatEdit(sm As SheetMetalComponentDefinition)
    ' Always leave flat-pattern edit mode, even after an error.
    If sm Is Nothing Then Return
    Try
        If sm.HasFlatPattern Then sm.FlatPattern.ExitEdit()
    Catch
    End Try
End Sub

Sub ScaleDxfBendDashes(dxfPath As String, scale As Double)
    ' Set DXF header $LTSCALE so dashed bend lines render with longer dashes.
    ' DXF stores settings as code/value pairs (group codes). Example:
    '   9
    '   $LTSCALE
    '   40
    '   10.0
    ' Encoding ISO-8859-1 keeps Inventor byte values (PL linetype names stay intact).
    If IsBlank(dxfPath) OrElse Not FileExists(dxfPath) OrElse scale <= 0 Then Return

    Dim enc As System.Text.Encoding = System.Text.Encoding.GetEncoding("ISO-8859-1")
    Dim lines As New List(Of String)
    lines.AddRange(System.IO.File.ReadAllLines(dxfPath, enc))
    If lines.Count < 8 Then Return

    Dim scaleText As String = scale.ToString(System.Globalization.CultureInfo.InvariantCulture)
    Dim i As Integer
    Dim found As Boolean = False

    ' Case 1: $LTSCALE already exists - overwrite its numeric value (group 40)
    For i = 0 To lines.Count - 2
        If lines(i).Trim() = "9" AndAlso lines(i + 1).Trim().ToUpperInvariant() = "$LTSCALE" Then
            Dim j As Integer
            Dim jMax As Integer = i + 6
            If jMax > lines.Count - 2 Then jMax = lines.Count - 2
            For j = i + 2 To jMax Step 2
                If lines(j).Trim() = "40" Then
                    lines(j + 1) = scaleText
                    found = True
                    Exit For
                End If
            Next
            Exit For
        End If
    Next

    ' Case 2: missing - insert before first ENDSEC (end of HEADER in Inventor flat DXF)
    If Not found Then
        For i = 0 To lines.Count - 2
            If lines(i).Trim() = "0" AndAlso lines(i + 1).Trim().ToUpperInvariant() = "ENDSEC" Then
                lines.Insert(i, scaleText)
                lines.Insert(i, " 40")
                lines.Insert(i, "$LTSCALE")
                lines.Insert(i, "  9")
                found = True
                Exit For
            End If
        Next
    End If

    If found Then System.IO.File.WriteAllLines(dxfPath, lines.ToArray(), enc)
End Sub

Function ExportStl(oDoc As Document) As String
    ' Single part -> always one STL file
    If IsPart(oDoc) Then Return ExportViaSaveAs(oDoc, "stl", GuidStl())

    ' Assembly -> depend on CfgStlAssemblyMode (1 / 2 / 3)
    Dim path As String = BuildExportPath(oDoc, "stl")
    Select Case CfgStlAssemblyMode()
        Case 1
            Return WriteExportFile(oDoc, path, GuidStl())
        Case 2
            Return StlAssemblyPerComponent(oDoc)
        Case 3
            ' Run both; JoinDetails keeps OK empty and merges any errors
            Return JoinDetails(WriteExportFile(oDoc, path, GuidStl()), StlAssemblyPerComponent(oDoc))
        Case Else
            Return "invalid CfgStlAssemblyMode"
    End Select
End Function

Function StlAssemblyPerComponent(oDoc As Document) As String
    ' One STL per leaf Part occurrence.
    ' Skips suppressed components, non-Part docs, and unsaved references.
    Dim nOk As Integer = 0
    Dim lastErr As String = ""
    Try
        Dim occ As ComponentOccurrence
        For Each occ In AsAssembly(oDoc).ComponentDefinition.Occurrences.AllLeafOccurrences
            If occ.Suppressed Then Continue For

            Dim refDoc As Document = TryGetOccurrencePart(occ)
            If refDoc Is Nothing Then Continue For

            Dim r As String = WriteExportFile(refDoc, ComponentStlPath(oDoc, refDoc), GuidStl())
            If IsFail(r) Then
                lastErr = r
            Else
                nOk += 1
            End If
        Next

        If nOk = 0 AndAlso IsBlank(lastErr) Then Return "no Part components"
        Return lastErr
    Catch ex As Exception
        Return ex.Message
    End Try
End Function

Function TryGetOccurrencePart(occ As ComponentOccurrence) As Document
    ' Return the Part document behind an occurrence, or Nothing if not usable.
    Try
        Dim refDoc As Document = occ.Definition.Document
        If refDoc Is Nothing OrElse Not IsPart(refDoc) OrElse Not HasSavedPath(refDoc) Then Return Nothing
        Return refDoc
    Catch
        Return Nothing
    End Try
End Function

Function ExportExcel(oDoc As Document) As String
    ' Dump Parts List (BOM) rows to CSV next to the drawing.
    ' No Excel.Application - COM SaveAs was unreliable; CSV opens in Excel.
    Dim path As String = BuildExportPath(oDoc, "csv")
    Dim arch As String = RequireArchive(path)
    If IsFail(arch) Then Return arch

    Try
        Dim lines As List(Of String) = CollectBomCsvLines(AsDrawing(oDoc))
        If lines.Count = 0 Then Return "no Parts List (BOM) on drawing"
        Return WriteUtf8BomLines(path, lines)
    Catch ex As Exception
        Return ex.Message
    End Try
End Function

Function CollectBomCsvLines(drw As DrawingDocument) As List(Of String)
    ' Walk all sheets; dump every PartsList into CSV lines.
    Dim lines As New List(Of String)
    Dim i As Integer
    For i = 1 To drw.Sheets.Count
        Try
            Dim sh As Sheet = drw.Sheets.Item(i)
            Dim pl As PartsList
            For Each pl In sh.PartsLists
                DumpPartsListCsv(pl, SafeSheetName(sh), lines)
            Next
        Catch
        End Try
    Next
    Return lines
End Function

'===== CSV TABLES =============================================================
' Only Parts List (BOM). Custom / revision / hole / bend tables are ignored.
' Separator is ";" (Polish Excel default).

Function CsvEscape(value As String) As String
    ' Make a cell safe for semicolon-separated CSV.
    If value Is Nothing Then value = ""
    value = value.Replace(vbCrLf, " ").Replace(vbCr, " ").Replace(vbLf, " ")
    If value.Contains(";") OrElse value.Contains(""""c) OrElse value.Contains(",") Then
        Return """" & value.Replace("""", """""") & """"
    End If
    Return value
End Function

Function CsvJoin(cells As List(Of String)) As String
    ' Join one CSV row with ";" between cells.
    Dim i As Integer
    Dim sb As New System.Text.StringBuilder()
    For i = 0 To cells.Count - 1
        If i > 0 Then sb.Append(";"c)
        sb.Append(CsvEscape(cells(i)))
    Next
    Return sb.ToString()
End Function

Function CellText(cell As Object) As String
    ' Prefer .Text; fall back to .Value (PartsList cells often use Value).
    Try
        Return CStr(cell.Text)
    Catch
        Try
            Return CStr(cell.Value)
        Catch
            Return ""
        End Try
    End Try
End Function

Function ColumnTitles(cols As Object) As List(Of String)
    ' Read header titles from a PartsListColumns collection.
    Dim c As Integer
    Dim header As New List(Of String)
    For c = 1 To ObjCount(cols)
        Try
            header.Add(CStr(cols.Item(c).Title))
        Catch
            header.Add("")
        End Try
    Next
    Return header
End Function

Function RowCells(rowObj As Object, colCount As Integer) As List(Of String)
    ' Read one data row as a list of cell strings.
    Dim c As Integer
    Dim data As New List(Of String)
    For c = 1 To colCount
        Try
            data.Add(CellText(rowObj.Item(c)))
        Catch
            data.Add("")
        End Try
    Next
    Return data
End Function

Function RowIsHidden(rowObj As Object) As Boolean
    ' PartsList rows can be invisible; skip them when dumping BOM.
    Try
        Return rowObj.Visible = False
    Catch
        Return False
    End Try
End Function

Sub DumpPartsListCsv(pl As PartsList, sheetLabel As String, lines As List(Of String))
    ' Write: title line -> header row -> data rows -> blank separator line.
    ' PartsList uses PartsListColumns / PartsListRows (not generic Rows/Columns).
    Dim title As String = ""
    Try : title = pl.Title : Catch : End Try

    Dim cols As Object = pl.PartsListColumns
    Dim rows As Object = pl.PartsListRows
    Dim colCount As Integer = ObjCount(cols)
    If colCount <= 0 Then Return

    lines.Add(CsvEscape("[" & sheetLabel & "] " & Nz(title, "Parts List")))
    lines.Add(CsvJoin(ColumnTitles(cols)))

    Dim r As Integer
    For r = 1 To ObjCount(rows)
        Dim rowObj As Object = rows.Item(r)
        If RowIsHidden(rowObj) Then Continue For
        lines.Add(CsvJoin(RowCells(rowObj, colCount)))
    Next
    lines.Add("")
End Sub

'===== ARCHIVE ================================================================
' If finalPath already exists: move/copy into
'   old\<base>_<yyyyMMdd.HHmmss>.<ext>
' Prefer Move; if the file is locked, try Copy (same idea as VBA ArchiveToOld).

Function ArchiveToOld(finalPath As String) As Boolean
    Try
        If IsBlank(finalPath) Then Return True

        finalPath = System.IO.Path.GetFullPath(finalPath)
        ' Nothing to archive - first export of this name
        If Not FileExists(finalPath) Then Return True

        Dim oldDir As String = System.IO.Path.Combine(System.IO.Path.GetDirectoryName(finalPath), "old")
        If Not EnsureDir(oldDir) Then
            MsgErr("Failed to archive into old\:" & vbCrLf & finalPath)
            Return False
        End If

        Dim dest As String = UniqueArchivePath(finalPath, oldDir)
        If TryMoveFile(finalPath, dest) Then Return True
        ' Fallback when Move fails (file open elsewhere, permissions, etc.)
        If TryCopyFile(finalPath, dest) Then Return True

        MsgErr("Failed to archive into old\:" & vbCrLf & finalPath)
        Return False
    Catch
        MsgErr("Failed to archive into old\:" & vbCrLf & finalPath)
        Return False
    End Try
End Function

Function UniqueArchivePath(finalPath As String, oldDir As String) As String
    ' Build old\<base>_<stamp>.ext ; add _2, _3... if that name already exists.
    Dim baseName As String = System.IO.Path.GetFileNameWithoutExtension(finalPath)
    Dim ext As String = System.IO.Path.GetExtension(finalPath)
    If ext.StartsWith(".") Then ext = ext.Substring(1)

    ' Stamp from the existing file's last write time
    Dim stamp As String = System.IO.File.GetLastWriteTime(finalPath).ToString("yyyyMMdd.HHmmss")
    Dim dest As String = System.IO.Path.Combine(oldDir, baseName & "_" & stamp & "." & ext)
    Dim n As Integer = 2
    Do While FileExists(dest)
        dest = System.IO.Path.Combine(oldDir, baseName & "_" & stamp & "_" & n & "." & ext)
        n += 1
    Loop
    Return dest
End Function

Function TryMoveFile(source As String, dest As String) As Boolean
    ' Prefer Move so the old file does not stay in the export folder.
    Try
        System.IO.File.Move(source, dest)
        Return FileExists(dest) AndAlso Not FileExists(source)
    Catch
        Return False
    End Try
End Function

Function TryCopyFile(source As String, dest As String) As Boolean
    ' Used when Move cannot lock/replace the source file.
    Try
        System.IO.File.Copy(source, dest, True)
        Return FileExists(dest)
    Catch
        Return False
    End Try
End Function