Zobrazit plnou verzi příspěvku: Automatizace - otevření modelu, export dxf...

michalkopriva
20.08.2019, 09:59
Zdravím,Zatím se mi nepovedlo něco podobného najít, tak snad někdo poradí.Je možné využít iLogic + Macro k tomu, aby mi Inventor sám otevřel model, vyexportoval dxf dle nějakého pravidla (to mám), bez uložení model zavřel... a tak pořád dokola? V excelu by byly názvy modelů (např.: A-321654, A123456, 123456, 19-108539...), které by vyhledával.Bohužel nevyužíváme Vault od Autodesku, máme BlueCielo Meridian. :-/Děkuji za nápady a pomoc.

Vladimír Michl
20.08.2019, 11:06

Asi by šlo řešit přes Plánovač úloh, iLogic a X-Tools, ale bude to výrazně složitější než s Vaultem.

Navara
20.08.2019, 11:16

Řešitelné to určitě je. Nicméně v rámci stability a odolnosti bych to dělal jako AddIn, který nevyžaduje například otevřený soubor pro spuštění. Jinak jako zdroj je asi vhodnější použít nějaký textový soubor, než excel, ale to už je čistě na vás. EDIT:Kromě samotného exportu do DXF by to mohlo vypadat asi nějak takhle... [code]Sub Main()    Dim excelFile As String = "C:\Temp\PartsForDxf.xlsx"    Dim excelSheet As String = "List1"    Dim dataFromExcel = ReadDataFromExcel(excelFile, excelSheet)    Dim fileNames = CreateFileNames(dataFromExcel)    For Each fileName As String In fileNames        'Check file exists        If Not System.IO.File.Exists(fileName) Then            MsgBox("File not found" & vbCrLf & fileName)            Continue For        End If        'Open file        Dim partDocument As PartDocument = ThisApplication.Documents.Open(fileName)        'Export to DXF        ExportToDxf(partDocument)        'Close without changes        partDocument.Close(True)    NextEnd SubPrivate Sub ExportToDxf(partDocument As PartDocument)    'Implement your export to DXF here    MsgBox(String.Format("Exporting to dxf...{1}{0}", partDocument.FullFileName, vbCrLf))End SubPrivate Function CreateFileNames(dataFromExcel As List(Of String)) As List(Of String)    Dim fileNames As New List(Of String)    For Each fileName As String In dataFromExcel        fileNames.Add(String.Format("C:\Temp\{0}.ipt", fileName))    Next    Return fileNamesEnd FunctionPrivate Function ReadDataFromExcel(excelFile As String, excelSheet As String) As List(Of String)    Dim cellValues As New List(Of String)    Dim column As String = "A"    Dim row As Integer = 1    GoExcel.Open(excelFile, excelSheet)    Do        Dim cellAddress As String = String.Format("{0}{1}", column, row)        Dim cellValue = GoExcel.CellValue(cellAddress)        If (cellValue Is Nothing OrElse cellValue.ToString() = "") Then            Exit Do        End If        cellValues.Add(cellValue)        row += 1    Loop    GoExcel.Close()    Return cellValuesEnd Function[/code]

Navara2019-08-20 11:54:51

michalkopriva
20.08.2019, 15:39
Super, moc děkuji za řešení.Jen tedy nevím, jak vytvořím AddIn. Jako makro mi to v Inventoru nefunguje :-/

Navara
20.08.2019, 21:19

Jak psát addin je trochu na delší povídání/psaní Nicméně jako makro to funguje. Jenom je potřeba mít vytvořený zdrojový soubor "C:\Temp\PartsForDxf.xlsx" a v něm na listu "List1" ve sloupci "A" seznam těch názvů souborů. Samozřejmě tohle není kompletní řešení, ale jenom první návrh a ukázka jak otevírat, exportovat a zavírat soubory definované v excelovské tabulce pomocí iLogicu. 

michalkopriva
21.08.2019, 08:40
To chápu :-)Budu si muset v práci vydupat nějaké školení.... Stále se mi to jako makro nedaří zprovoznit. Mám s tím problém ve VBA Editoru :-/Zdrojový soubor jsem si změnil, názvy souborů ve sloupci "A" mám.

Navara
21.08.2019, 09:09

Ten kód je v iLogicu, ne ve VBA. Tam by to bylo podstatně horší, až neřešitelné. Už jenom to čtení z excelu by byl docela ořech. Takže spusťte to jako pravidlo iLogic a bude to chodit.  

michalkopriva
21.08.2019, 11:18
Aha, no tak trochu jsem to tušil, ale zmátlo mě jak jsme se bavili o makru :-DNevím, proč jsem to nevyzkoušel :-DParáda, funguje to :-)Jen to tedy nenajde žádný model :-/Jakou cestu k modelům nastavit, když používáme BlueCielo - Meridian?

Navara
21.08.2019, 14:55

To už je věc implementace. Já nevím, kam se ty soubory stahujou, ale aby tohle makro fungovalo, tak to musí být někde na lokálním disku. Čekal bych, že budou někde v pracovním adresáři Inventoru.Pokud nevíte, jestli jsou na disku a chcete je stahovat z Meridianu, tak to se musíte obrátit na ně. V tom už vám nepomůžu.

michalkopriva
21.08.2019, 15:15
Dobře, myslel jsem jestli není nějaká možnost, jak inventoru říct, že to má hledat v Meridianu.Pokusím se to zjistit u nich.Jinak tedy u modelů co jsou na disku to funguje.Jen když to exportuje dxf, tak ho to nepojmenuje dle modelu ze kterého se exportuje...Název exportovaného dxf je prázdný.Sub Main()    Dim excelFile As String = "C:\Users\czmiko4\Desktop\Test-excel-export\Test.xlsx"    Dim excelSheet As String = "List1"    Dim dataFromExcel = ReadDataFromExcel(excelFile, excelSheet)    Dim fileNames = CreateFileNames(dataFromExcel)    For Each fileName As String In fileNames        'Check file exists        If Not System.IO.File.Exists(fileName) Then            MsgBox ("File not found" & vbCrLf & fileName)            Continue For        End If        'Open file        Dim partDocument As PartDocument = ThisApplication.Documents.Open(fileName)        'Export to DXF        ExportToDxf (partDocument)        'Close without changes        partDocument.Close (True)    NextEnd SubPrivate Sub ExportToDxf(partDocument As partDocument)    'Implement your export to DXF here    Dim FilePath As String    FilePath = "C:\Users\czmiko4\Desktop\Test-excel-export\"                                             If ThisApplication.ActiveDocument.ComponentDefinition.HasFlatPattern = False Then                          ThisApplication.ActiveDocument.ComponentDefinition.Unfold                                            Else       ThisApplication.ActiveDocument.ComponentDefinition.FlatPattern.Delete                                   ThisApplication.ActiveDocument.ComponentDefinition.Unfold                                            End If    Dim fSett As String    fSett = "FLAT PATTERN DXF?AcadVersion=2000&OuterProfileLayer=IV_INTERIOR_PROFILES"                          Dim fSname As String    fSname = FilePath & ThisDoc.FileName(False) & ".dxf"                                                        ThisApplication.ActiveDocument.ComponentDefinition.DataIO.WriteDataToFile( fSett, fSname)              'MessageBox.Show("DXF uložen jako: " & fSname ,"Uložení DXF rozvinu", MessageBoxButtons.OK)               ThisApplication.ActiveDocument.ComponentDefinition.FlatPattern.ExitEdit'    MsgBox(String.Format("Exporting to dxf...{1}{0}", partDocument.FullFileName, vbCrLf))End SubPrivate Function CreateFileNames(dataFromExcel As List(Of String)) As List(Of String)    Dim fileNames As New List(Of String)    For Each fileName As String In dataFromExcel        fileNames.Add(String.Format("C:\Users\czmiko4\Desktop\Test-excel-export\{0}.ipt", fileName))    Next    Return fileNamesEnd FunctionPrivate Function ReadDataFromExcel(excelFile As String, excelSheet As String) As List(Of String)    Dim cellValues As New List(Of String)    Dim column As String = "A"    Dim row As Integer = 1    GoExcel.Open(excelFile, excelSheet)    Do        Dim cellAddress As String = String.Format("{0}{1}", column, row)        Dim cellValue = GoExcel.CellValue(cellAddress)        If (cellValue Is Nothing OrElse cellValue.ToString() = "") Then            Exit Do        End If        cellValues.Add (cellValue)        row += 1    Loop    GoExcel.Close()    Return cellValuesEnd Function

Navara
26.08.2019, 10:37
Problém je v tom, že při vytváření jména souboru používáte ThisDoc, což není v daném přípapadě možné.Dim fSname As String    fSname = FilePath & ThisDoc.FileName(False) & ".dxf"Je potřeba vycházet z argumentu partDocumentNapř.:[code] Dim fName = System.IO.Path.ChangeExtension(partDocument.FullFileName, ".dxf") MsgBox(fName)[/code]Dále je potřeba se v této metodě vyvarovat používání ThisApplication.ActiveDocument. To nemusí skončit dobře.
Navara2019-08-26 10:45:15