Externí odkaz

main.vb

Sub exportBOMTable()
    Dim oDrwDoc As DrawingDocument
    Dim oSheet As Sheet
    Dim partsList As partsList
    Dim tableRow As PartsListRow
    Dim csvFile As String
    Dim outputFile As Integer
    Dim rowIndex As Integer
    Dim colIndex As Integer
    Dim cellValue As String
 
    MsgBox "Start programu na převod rozpisky do CSV"
 
    ' Set the active drawing document
    Set oDrwDoc = ThisApplication.ActiveDocument
 
    ' Set the active sheet
    Set oSheet = oDrwDoc.ActiveSheet
 
    ' Zjistíme, jestli na výkrese existuje rozpiska
    If oSheet.PartsLists.Count > 0 Then
        MsgBox "Rozpiska existuje :) a tak budu exportovat ;) "
        ' Zde se provádí export CSV
 
 
 
 
        Set partsList = oSheet.PartsLists(1)
        csvFile = "C:\temp\rozpiska_export.csv"
        outputFile = FreeFile
        Open csvFile For Output As outputFile
        ' Iterace přes řádky a sloupce rozpisky a zápis do CSV
        For rowIndex = 1 To partsList.PartsListRows.Count
            ' Inicializace řádku pro CSV
            Dim rowData As String
            rowData = ""
 
            Set tableRow = partsList.PartsListRows(rowIndex)
 
            ' Iterace přes jednotlivé buňky v řádku
            For colIndex = 1 To partsList.ColumnCount
                cellValue = tableRow.Item(colIndex).Value
                ' Přidání hodnoty buňky do řádku a oddělení středníkem
                rowData = rowData & cellValue & ";"
            Next colIndex
 
                ' Odstranění posledního středníku a zapsání řádku do CSV
                rowData = Left(rowData, Len(rowData) - 1)
                Print #outputFile, rowData
        Next rowIndex
 
        ' Uzavření souboru
        Close outputFile
 
        MsgBox "Rozpiska byla úspěšně exportována do: " & csvFile
 
    Else
        MsgBox "Rozpiska neexistuje :( a tak se nic nestane ..."
    End If
    MsgBox "Konec programu"
End Sub

vzor.vb

Sub ExportRozpiskaToCSV()
    Dim invApp As Inventor.Application
    Dim drawingDoc As Inventor.DrawingDocument
    Dim partsList As partsList
    Dim tableRow As PartsListRow
    Dim csvFile As String
    Dim outputFile As Integer
    Dim rowIndex As Integer
    Dim colIndex As Integer
    Dim cellValue As String
 
    ' Připojení k aplikaci Inventor
    On Error Resume Next
    Set invApp = GetObject(, "Inventor.Application")
    If invApp Is Nothing Then
        MsgBox "Inventor není spuštěn."
        Exit Sub
    End If
    On Error GoTo 0
 
    ' Získání aktivního výkresového dokumentu
    Set drawingDoc = invApp.ActiveDocument
 
    ' Kontrola, zda je aktivní dokument výkres
    If drawingDoc.DocumentType <> kDrawingDocumentObject Then
        MsgBox "Aktivní dokument není výkres!"
        Exit Sub
    End If
 
    ' Získání rozpisky (PartsList) na výkresu
    If drawingDoc.PartsLists.Count = 0 Then
        MsgBox "Na výkresu není žádná rozpiska!"
        Exit Sub
    End If
 
    ' Předpokládáme, že chceme exportovat první rozpisku (pokud jich je více, můžete si vybrat konkrétní)
    Set partsList = drawingDoc.PartsLists(1)
 
    ' Cesta k exportnímu souboru CSV
    csvFile = "C:\temp\rozpiska_export.csv"
    outputFile = FreeFile
 
    ' Otevření souboru pro zápis
    Open csvFile For Output As outputFile
 
    ' Iterace přes řádky a sloupce rozpisky a zápis do CSV
    For rowIndex = 1 To partsList.PartsListRows.Count
        ' Inicializace řádku pro CSV
        Dim rowData As String
        rowData = ""
 
        Set tableRow = partsList.PartsListRows(rowIndex)
 
        ' Iterace přes jednotlivé buňky v řádku
        For colIndex = 1 To partsList.ColumnCount
            cellValue = tableRow.Item(colIndex).Value
            ' Přidání hodnoty buňky do řádku a oddělení středníkem
            rowData = rowData & cellValue & ";"
        Next colIndex
 
        ' Odstranění posledního středníku a zapsání řádku do CSV
        rowData = Left(rowData, Len(rowData) - 1)
        Print #outputFile, rowData
    Next rowIndex
 
    ' Uzavření souboru
    Close outputFile
 
    MsgBox "Rozpiska byla úspěšně exportována do: " & csvFile
End Sub