Zobrazit plnou verzi příspěvku: export souborů dxf jen u plechových součátí
carlosiiino
06.04.2016, 13:28
Dobrý den, mám vytvořené pravidlo pro export rozvinů plechových součástí (viz.níže), ale potřebuji do kódu nějak zakombinovat, aby vyhledal jen plechové součásti a ne objemové. Může mi někdo poradit ? Děkuji
SyntaxEditor Code SnippetSub Main()
Dim sFile As String, sInDir As String, sOutDir As String, I As String
Dim oDocs As Documents, oDoc As Document
oDocs = ThisApplication.Documents
'Cesta pro otevření a uložení souboru
sInDir = (ThisDoc.Path & "\")
sOutDir = (ThisDoc.Path & "\DXF\")
sFile = Dir(sInDir)
While (sFile <> "")
'Definice formatu souboru pro otevření (IPT, IAM, IDW...)
If (Right(sFile, 3) = "ipt") Then
Debug.Print (sFile)
oDoc = oDocs.Open(sInDir & sFile, False)
' Vytvořit objekt DataIO
Dim oDataIO As DataIO
oDataIO = oDoc.ComponentDefinition.DataIO
' Parametry definující formát výstupního souboru DXF
Dim sParam As String
sParam = "FLAT PATTERN DXF?AcadVersion=2000"
' Vytvořit výstupní DXF soubor v adresáři
Dim sDXFFileName As String
sDXFFileName = (sOutDir & Left(sFile, Len(sFile) - 3) & "DXF")
MessageBox.Show(sDXFFileName, " CESTA SOUBORU")
oDataIO.WriteDataToFile (sParam, sDXFFileName)
End If
sFile = Dir
End While
End Sub
Lze porovnat vlastnost DocumentSubTypeID [code]...oDoc = oDocs.Open(sInDir & sFile, False)If oDoc.DocumentSubType.DocumentSubTypeID <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then Continue While ' Vytvořit objekt DataIODim oDataIO As DataIO...[/code]
carlosiiino
11.04.2016, 07:38
Dobrý den,děkuji za rychlou reakci.
SyntaxEditor Code SnippetMůžete mi prosím ještě poradit, proč mi Inventor po vytvoření posledního dxf zamrzne a nereaguje?Upravený kód níže.DěkujiSub Main()
Dim sFile As String, sInDir As String, sOutDir As String, I As String
Dim oDocs As Documents, oDoc As Document
oDocs = ThisApplication.Documents
'Cesta pro otevření a uložení souboru
sInDir = (ThisDoc.Path & "\")
sOutDir = (ThisDoc.Path & "\DXF\")
sFile = Dir(sInDir)
While (sFile <> "")
'Definice formatu souboru pro otevření (IPT, IAM, IDW...)
If (Right(sFile, 3) = "ipt") Then
Debug.Print (sFile)
oDoc = oDocs.Open(sInDir & sFile, False)
If oDoc.DocumentSubType.DocumentSubTypeID <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then Continue While
' Vytvořit objekt DataIO
Dim oDataIO As DataIO
oDataIO = oDoc.ComponentDefinition.DataIO
' Parametry definující formát výstupního souboru DXF
Dim sParam As String
sParam = "FLAT PATTERN DXF?AcadVersion=2000&InvisibleLayers=IV_TANGENT;IV_BEND;IV_BEND_DOWN"
' Vytvořit výstupní DXF soubor v adresáři
Dim sDXFFileName As String
sDXFFileName = (sOutDir & Left(sFile, Len(sFile) - 3) & "DXF")
MessageBox.Show(sDXFFileName, " CESTA SOUBORU")
oDataIO.WriteDataToFile (sParam, sDXFFileName)
oDoc.Close(True)
End If
sFile = Dir
End While
End Sub
Myslím, že to dělá ten cyklus While, kde v případě, že to není plech, nedojde k nastavení na další název souboru a smyčka se zasekne.Já dávám přednost použití cyklu For Each, kde jako kolekci pro procházení použiju seznam všech souborů v daném adresáři. [code]Dim path = sInDirDim files = IO.Directory.GetFiles(path,"*.ipt", SearchOption.TopDirectoryOnly) 'Or: SearchOption.AllDirectoriesFor Each file As String In files Dim document = ThisApplication.Documents.Open(file) If document.DocumentSubType.DocumentSubTypeID <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then document.Close() Continue For End If 'TODO: Export DXF hereNext[/code]
Teoreticky by se dalo použít něco na tenhle způsob, ale ani Microsoft to nedoporučuje.[code]While sFile<>"" dim oDoc = oDocs.Open(sInDir & sFile, False) If oDoc.DocumentSubType.DocumentSubTypeID <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then sFile = Dir() Continue While End If ' Vytvořit objekt DataIO Dim oDataIO As DataIOEnd While[/code]