CadPaste

Inventor · iLogic · 2 дня назад

Экспорт файла (PDF, DXF, STL, CSV)

Этот макрос позволяет записывать одним кликом файл в разных форматах - PDF, STL, DXF и таблицы в Exel (CSV). Типы экспортируемых форматов и способы работы можно регулировать в настройках. Старые файлы можно переносятся в папку OLD.

Как пользоваться


Макрос содержит список конфигурирующих переменных, включая и выключая которые можно управлять его работой.

  • CfgExportPdf - экспорт в PDF
  • CfgExportDxf - экспорт в DXF
  • CfgExportStl - экспорт в STL
  • CfgExportExcel - экспорт спецификации в Exel
  • CfgStlAssemblyMode - способ экспорта сборок в STL (1 - одним файлом, 2 - каждая деталь отдельно, 3 - оба способа)
  • CfgDxfAddThickness - добавить в название файла развертки (DXF) толщину элемента
  • CfgRemoveSpaces - убрать пробелы в файле экспорта
  • CfgNotify - высвечивать все комуникаты или только ошибки
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

Все макросы InventorНаписать об этом макросе