====== Visual Basic ====== ===== Tutorial ===== [[https://knowledge.autodesk.com/search-result/caas/simplecontent/content/lesson-1-the-basic-plug--E2-80-93-autodesk-inventor.html|Externí odkaz]] ===== Export rozpisky z výkresu do CSV ===== 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 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