Всім привіт!
Дякую за пропозицію від @Andrii_Humeniuk щодо теми, що популярна як в англомовній гілці, так і щодо Fusion 360. Та саме ця про експорт плоских та гнутих деталей в dxf з Autodesk Inventor. Як це краще робити?
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" повідомленню! | Do you find the posts helpful? "LIKE" these posts!
На ваше запитання відповіли? Натисніть кнопку 'ПРИЙНЯТИ РІШЕННЯ' | Have your question been answered successfully? Click 'ACCEPT SOLUTION' button.
Дмитро Мухін | Dmytro Mukhin Facebook | Instagram | InventorInUa

Gelöst! Gehe zur Lösung
Gelöst von Andrii_Humeniuk. Gehe zur Lösung
Вітаю @DmytroMukhin .
Хоча я ще не стикався з цим питанням на українській гілці форуму, але на англійській гілці, безперечно, експорт в форматі DXF є одним з найрозповсюдженіших питань.
Зазвичай, людям потрібно знайти яке-небудь рішення для конкретної задачі, наприклад, експорт креслення, збірки чи деталі. Одного разу я бачив навіть запитання щодо експорту найбільшої площини на плоскій деталі. Тому, аби повністю розібратися з цим питанням, я хочу поділитися макросом, який використовую для цієї мети.
Особливості:
* Для того щоб не експортувались всі деталі зі збірки, у макросі є селектор CheckPart(). У моєму випадку це перевірка відповідності стандарту деталі (ДСТУ 8540). Це індивідуальний селектор для мене, і для кожного потрібно прописувати свій сцинарій.
Sub Main()
Dim oInvApp As Inventor.Application = ThisApplication
Dim oCM As CommandManager = oInvApp.CommandManager
Dim oDoc As Document = oInvApp.ActiveDocument
Dim sFileName As String
Dim sPath As String = CheckFolder(oDoc)
If TypeOf oDoc Is PartDocument Then
If CheckPart(oDoc) Then Exit Sub
sFileName = CheckFullName(oDoc)
Call CreateDXF(oCM, oDoc, sPath & sFileName)
Call OpenFolder(sPath & sFileName)
Else If TypeOf oDoc Is AssemblyDocument Then
Call WorkingWithAssembly(oInvApp, oDoc, sPath)
Else If TypeOf oDoc Is DrawingDocument Then
Dim oDDoc As DrawingDocument = oDoc
If oDDoc.Sheets.Count = 0 Then Exit Sub
Dim oViews As DrawingViews = oDDoc.Sheets(1).DrawingViews
If oViews.Count = 0 Then Exit Sub
Dim oRefDoc As Document = oViews(1).ReferencedDocumentDescriptor.ReferencedDocument
If TypeOf oRefDoc Is AssemblyDocument Then
Call WorkingWithAssembly(oInvApp, oRefDoc, sPath)
Else If TypeOf oRefDoc Is PartDocument Then
If CheckPart(oRefDoc) Then Exit Sub
sFileName = CheckFullName(oRefDoc)
Call CreateDXF(oCM, oRefDoc, sPath & sFileName)
Call OpenFolder(sPath & sFileName)
End If
End If
End Sub
Private Function CheckPart(ByVal oPDoc As Document) As Boolean
If oPDoc.PropertySets("Design Tracking Properties")("Catalog Web Link").Value = "ДСТУ 8540" Then Return False
Return True
End Function
Private Function CheckFolder(ByVal oPDoc As Document) As String
Dim sPath As String = System.IO.Path.GetDirectoryName(oPDoc.File.FullFileName) & "\DXF Files"
If Not System.IO.Directory.Exists(sPath) Then System.IO.Directory.CreateDirectory(sPath)
Return sPath
End Function
Private Function CheckFullName(ByVal oPDoc As PartDocument, Optional ByVal iQty As Integer = 0) As String
Dim sFileName As String = System.IO.Path.GetFileNameWithoutExtension(oPDoc.FullFileName)
If iQty = 0 Then : sFileName = "\" & sFileName & ".dxf"
Else : sFileName = "\" & sFileName & " (" & iQty & ").dxf" : End If
Return sFileName
End Function
Private Function OpenFolder(ByVal sFolderPath As String)
If Not System.IO.File.Exists(sFolderPath) Then Exit Function
System.Diagnostics.Process.Start("explorer.exe", "/select,""" & sFolderPath & """")
End Function
Private Sub WorkingWithAssembly(ByVal oInvApp As Inventor.Application, ByVal oAsmDoc As AssemblyDocument, ByVal sPath As String)
Dim oCM As CommandManager = oInvApp.CommandManager
Dim oRefDocs As DocumentsEnumerator = oAsmDoc.AllReferencedDocuments
Dim oPBar As Inventor.ProgressBar
oPBar = oInvApp.CreateProgressBar(False, oRefDocs.Count, "Exporting DXF...")
oPBar.Message = ("Loading...")
Dim oOccs As ComponentOccurrences = oAsmDoc.ComponentDefinition.Occurrences
For i As Integer = 1 To oRefDocs.Count
oPBar.Message = ("Create DXF files. Progress " & i & " of " & oRefDocs.Count & ".")
oPBar.UpdateProgress
If Not TypeOf oRefDocs(i) Is PartDocument Or CheckPart(oRefDocs(i)) Then Continue For
If oOccs.AllReferencedOccurrences(oRefDocs(i)).Count > 0 Then
sFileName = CheckFullName(oRefDocs(i), oOccs.AllReferencedOccurrences(oRefDocs(i)).Count)
Dim oPDoc As PartDocument = oInvApp.Documents.Open(oRefDocs(i).FullFileName, True)
Call CreateDXF(oCM, oPDoc, sPath & sFileName)
oPDoc.Close()
End If
Next i
oPBar.Close()
Call OpenFolder(sPath & sFileName)
End Sub
Private Sub CreateDXF(ByVal oCM As CommandManager, ByVal oPDoc As PartDocument, ByVal sName As String)
Dim oSS As SelectSet = oPDoc.SelectSet
Select Case oPDoc.SubType
Case "{4D29B490-49B2-11D0-93C3-7E0706000000}"
Dim dMaxArea As Double
Dim oBody As SurfaceBody = oPDoc.ComponentDefinition.SurfaceBodies.Item(1)
For i As Integer = 1 To oBody.Faces.Count
If oBody.Faces(i).Evaluator.Area > dMaxArea Then dMaxArea = oBody.Faces(i).Evaluator.Area
Next i
For i As Integer = 1 To oBody.Faces.Count
If oBody.Faces(i).Evaluator.Area = dMaxArea Then
oCM.PostPrivateEvent(PrivateEventTypeEnum.kFileNameEvent, sName)
oSS.Select(oBody.Faces(i))
oCM.ControlDefinitions("GeomToDXFCommand").Execute()
oSS.Clear()
Exit For
End If
Next i
Case "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
Dim oCompDef As SheetMetalComponentDefinition = oPDoc.ComponentDefinition
If Not oCompDef.HasFlatPattern Then : oCompDef.Unfold
Else : oCompDef.FlatPattern.Edit : End If
Dim sOut As String = "FLAT PATTERN DXF?AcadVersion=2018" _
& "&InteriorProfileLayer=IV_INTERIOR_PROFILES" _
' & "&InteriorProfilesLayerColor=255;255;0" _
' & "&OuterProfileLayer=IV_EXTERIOR_PROFILES" _
' & "&InvisibleLayers=IV_TANGENT" _
' & "&SimplifySplines=True" _
' & "&BendLayerLineType=37633" _
' & "&BendLayerColor=255;255;0" _
' & "&BendUpLayerLineType=37633" _
' & "&BendUpLayerColor=255;255;0" _
' & "&BendDownLayerLineType=37633" _
' & "&BendDownLayerColor=255;255;0" _
' & "&FeatureProfilesLayerLineType=37633" _
' & "&FeatureProfilesLayerColor=255;255;0" _
' & "&FeatureProfilesUpLayerLineType=37633" _
' & "&FeatureProfilesUpLayerColor=255;255;0" _
' & "&FeatureProfilesDownLayerLineType=37633" _
' & "&FeatureProfilesDownLayerColor=255;255;0"
oCompDef.DataIO.WriteDataToFile(sOut, sName)
oCompDef.FlatPattern.ExitEdit
End Select
End SubБуду радий адаптувати селектор для кожного, хто зацікавився публікацією, та прийму до уваги цікаві пропозиції щодо вдосконалення.
Andrii Humeniuk - CAD Coordinator, Autodesk Certified Instructor
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.
Дякую!
Можливо, буде цікаво про це почитати @Yaroslav.shelest.
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" повідомленню! | Do you find the posts helpful? "LIKE" these posts!
На ваше запитання відповіли? Натисніть кнопку 'ПРИЙНЯТИ РІШЕННЯ' | Have your question been answered successfully? Click 'ACCEPT SOLUTION' button.
Дмитро Мухін | Dmytro Mukhin Facebook | Instagram | InventorInUa

Добрий день.
А для якої версії це написано? В 2023 отримую таке повідомлення...чи я щось не вірно роблю?
upd. зрозумів це ilogic :))) ніяк до нього не звикну...як і до того що в Inventor базово відсутні прості опції які є в інших рішеннях. в 2023 році треба писати скрипта щоб зберегти в DXF....я думав ми це пройшли в 10 років тому.
Відповідь корисна? Клікніть на"ВПОДОБАЙКУ"цим повідомленням! | Do you find the posts helpful? "LIKE" these posts!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click"ACCEPT SOLUTION"
Yaroslav Shelest / Ярослав Шелест
BIM-Manager & Civil Engineer & Інженер ПЦБ
Facebook |LinkedIn |Autodesk |Behance
Вітаю @Yaroslav.shelest !
Найпростіший спосіб зрозуміти, який код перед вами, це подивитись, яким чином задана змінна. У випадку з VB.NET обов'язково потрібно писати "Set" (Set oinvApp = ThisApplication), для iLogic цього робити не потрібно.
У Inventor присутній функціонал експорту у формат DXF, і я впевнений, що на Autodesk Apps можна знайти чудові публікації. Проте це ніколи не зрівнюється з індивідуальним налаштуванням. Саме це я й пропагандую: індивідуальні налаштування програм, орієнтовані на потреби загального користувача.
Andrii Humeniuk - CAD Coordinator, Autodesk Certified Instructor
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.
'Призначення активного документа збірка Dim oAsmDoc As AssemblyDocument oAsmDoc = ThisApplication.ActiveDocument oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) -4) 'Перевірка файла - збірка чи ні If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then MessageBox.Show("Це правило працює в збірці", "iLogic") Exit Sub End If 'Користувацький запит RUsure = MessageBox.Show ( _ "Зробить DXF файли зі всіх деталей котори є листовим металом." _ & vbLf & "Сподіваюсь, що ти зберіг збірку." _ & vbLf & " " _ & vbLf & "Ти впевненний у початки работи?" _ & vbLf & "Це займе деякий час", "iLogic", MessageBoxButtons.YesNo) If RUsure = vbNo Then Return End If 'Отримуєм позначення деталі з властивостей Dim oDoc As AssemblyDocument oDoc = ThisApplication.ActiveDocument Dim partNumber As String = oDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value oPath = ThisDoc.Path oDataMedium = ThisApplication.TransientObjects.CreateDataMedium oContext = ThisApplication.TransientObjects.CreateTranslationContext oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism oOptions = ThisApplication.TransientObjects.CreateNameValueMap 'Отримуєм папку призначення для DXF файлів oFolder = oPath & "\" & partNumber & " DXF Files" 'Перевірка що папка для DXF файлів створена If Not System.IO.Directory.Exists(oFolder) Then System.IO.Directory.CreateDirectory(oFolder) End If 'MessageBox.Show("Папка створена: " & oFolder, "Debug") 'Перегляньте файли, на які посилається збірка Dim oRefDocs As DocumentsEnumerator oRefDocs = oAsmDoc.AllReferencedDocuments Dim oRefDoc As Document Dim processedFiles As Integer = 0 'Опрацюйте файли креслень для посилань на моделі For Each oRefDoc In oRefDocs iptPathName = Left(oRefDoc.FullDocumentName, Len(oRefDoc.FullDocumentName) - 3) & "ipt" 'Перевірте, чи модель збережена If System.IO.File.Exists(iptPathName) Then Dim oDrawDoc As PartDocument oDrawDoc = ThisApplication.Documents.Open(iptPathName, True) oFileName = Left(oRefDoc.DisplayName, Len(oRefDoc.DisplayName)) Try 'Встановіть назву цільового файлу DXF Dim partNumberD As String = oDrawDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value 'Отримання товщини металу деталі Dim thickness As Double = 0 Dim oCompDef As SheetMetalComponentDefinition oCompDef = oDrawDoc.ComponentDefinition If TypeOf oCompDef Is SheetMetalComponentDefinition Then Dim oSheetMetalCompDef As SheetMetalComponentDefinition = oCompDef thickness = oSheetMetalCompDef.Thickness.Value * 10 ' см в мм 'MessageBox.Show("Товщина: " & thickness & " мм для деталі: " & oFileName, "Debug") Try CustomName = iProperties.Value(oFileName, "Custom", "PF*PRT_ZNR") Catch CustomName = partNumberD & "_s" & CInt(thickness).ToString() 'Перетворіть на ціле число, а потім на текст End Try oDataMedium.FileName = oFolder & "\" & CustomName & ".dxf" If oCompDef.HasFlatPattern = False Then oCompDef.Unfold Else oCompDef.FlatPattern.Edit End If Dim sOut As String ' sOut = "FLAT PATTERN DXF?AcadVersion=R12&ConfigFile=c:\Temp\R12.ini" sOut = "FLAT PATTERN DXF?AcadVersion=2018" _ & "&InteriorProfileLayer=IV_INTERIOR_PROFILES" _ ' & "&SimplifySplines=True" _ ' & "&InteriorProfilesLayerColor=255;255;0" _ ' & "&OuterProfileLayer=IV_EXTERIOR_PROFILES" _ ' & "&InvisibleLayers=IV_TANGENT" _ ' & "&BendLayerLineType=37633" _ ' & "&BendLayerColor=255;255;0" _ ' & "&BendUpLayerLineType=37633" _ ' & "&BendUpLayerColor=255;255;0" _ ' & "&BendDownLayerLineType=37633" _ ' & "&BendDownLayerColor=255;255;0" _ ' & "&FeatureProfilesLayerLineType=37633" _ ' & "&FeatureProfilesLayerColor=255;255;0" _ ' & "&FeatureProfilesUpLayerLineType=37633" _ ' & "&FeatureProfilesUpLayerColor=255;255;0" _ ' & "&FeatureProfilesDownLayerLineType=37633" _ ' & "&FeatureProfilesDownLayerColor=255;255;0" oCompDef.DataIO.WriteDataToFile(sOut, oDataMedium.FileName) oCompDef.FlatPattern.ExitEdit processedFiles = processedFiles + 1 'MessageBox.Show("Створен DXF: " & oDataMedium.FileName, "Debug") Else 'MessageBox.Show("Пропущено, так як деталь не є листовою: " & oFileName, "Debug") End If Catch ex As Exception 'MessageBox.Show("Помилка в файлі " & oFileName & ": " & ex.Message, "Error") End Try oDrawDoc.Close End If Next MessageBox.Show("Процес завершено. Створено " & processedFiles & " DXF файлів.", "Complete")
Десь знайшов такий скрипт. Трішки переробив його під себе. Назва папки - як Позначення збірки. Dxf - робить тільки листових деталей, які зроблені як листові (мають розгортку). Він в назву файда додає товщину метала - ( формат: АБВ-00.00.000_s10.dxf (приклад)).
Але Ваш працює швидше. Та, якось краще ))). Може в Ваш код додати ці функції: формат АБВ-00.....000_s... (кількість деталей шт.).dxf.
А ще - я ніде не зміг знайти таке - в dxf файлі експортуются лінії переходу, а можна щоб в файл експортувалися тільки лінії гибу? Коли відкриваєшь dxf, то ці лінії в потрібному слої і його можна вимкнути, але мені здається, що це для оператора ЧПУ не потрібно. Може я помиляюсь та їм (операторам) зручніше так. Якщо хтось є з досвідом - підкажіть як краще.
Вітаю @anton.mashkin.ua .
Дякую за коментар. Сподіваюсь наступний скрипт виправдає Ваші очікування.
Public Sub Main()
Dim oInvApp As Inventor.Application = ThisApplication
oCM = oInvApp.CommandManager
Dim oDoc As Document = oInvApp.ActiveDocument
Dim sFileName As String
Dim sPath As String = CheckFolder(oDoc)
If TypeOf oDoc Is PartDocument Then
If CheckPart(oDoc) Then Exit Sub
sFileName = CheckFullName(oDoc)
Call CreateDXF(oDoc, sPath & sFileName)
Shell("explorer.exe /Open," & sPath, vbNormalFocus)
Else If TypeOf oDoc Is AssemblyDocument Then
Call WorkingWithAssembly(oInvApp, oDoc, sPath)
Else If TypeOf oDoc Is DrawingDocument Then
Dim oDDoc As DrawingDocument = oDoc
If oDDoc.Sheets.Count = 0 Then Exit Sub
Dim oViews As DrawingViews = oDDoc.Sheets(1).DrawingViews
If oViews.Count = 0 Then Exit Sub
Dim oRefDoc As Document = oViews(1).ReferencedDocumentDescriptor.ReferencedDocument
If TypeOf oRefDoc Is AssemblyDocument Then
Call WorkingWithAssembly(oInvApp, oRefDoc, sPath)
Else If TypeOf oRefDoc Is PartDocument Then
If CheckPart(oRefDoc) Then Exit Sub
sFileName = CheckFullName(oRefDoc)
Call CreateDXF(oRefDoc, sPath & sFileName)
Shell("explorer.exe /Open," & sPath, vbNormalFocus)
End If
End If
End Sub
Property oCM As CommandManager
Property sColor As String = "255;255;0" ' yellow
Private Function CheckPart(ByVal oPDoc As Document) As Boolean
Dim sStand As String = oPDoc.PropertySets("Design Tracking Properties")("Catalog Web Link").Value
If sStand = "ДСТУ 8540" Or sStand = "EN 10131" Then Return False
Return True
End Function
Private Function CheckFolder(ByVal oPDoc As Document) As String
Dim sPath As String = System.IO.Path.GetDirectoryName(oPDoc.File.FullFileName) & "\DXF Files"
If Not System.IO.Directory.Exists(sPath) Then System.IO.Directory.CreateDirectory(sPath)
Return sPath
End Function
Private Function CheckFullName(ByVal oPDoc As PartDocument) As String
Return "\" & oPDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value & ".dxf"
End Function
Private Sub WorkingWithAssembly(ByVal oInvApp As Inventor.Application, ByVal oAsmDoc As AssemblyDocument, ByVal sPath As String)
Dim oRefDocs As DocumentsEnumerator = oAsmDoc.AllReferencedDocuments
Dim oPBar As Inventor.ProgressBar
oPBar = oInvApp.CreateProgressBar(False, oRefDocs.Count, "Exporting DXF...")
oPBar.Message = ("Loading...")
Dim oOccs As ComponentOccurrences = oAsmDoc.ComponentDefinition.Occurrences
Dim sLastPart As String
For i As Integer = 1 To oRefDocs.Count
oPBar.Message = ("Create DXF files. Progress " & i & " of " & oRefDocs.Count & ".")
oPBar.UpdateProgress
If Not TypeOf oRefDocs(i) Is PartDocument Or CheckPart(oRefDocs(i)) Then Continue For
If Not oRefDocs(i).SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then Continue For
If oOccs.AllReferencedOccurrences(oRefDocs(i)).Count > 0 Then
sLastPart = CheckFullName(oRefDocs(i))
Dim oPDoc As PartDocument = oInvApp.Documents.Open(oRefDocs(i).FullFileName, True)
Call CreateDXF(oPDoc, sPath & sLastPart)
oPDoc.Close()
End If
Next i
oPBar.Close()
Shell("explorer.exe /Open," & sPath, vbNormalFocus)
End Sub
Private Sub CreateDXF(ByVal oPDoc As PartDocument, ByVal sName As String)
Dim oCompDef As SheetMetalComponentDefinition = oPDoc.ComponentDefinition
Dim dThink As Double = Round(oCompDef.Thickness.Value * 10, 3)
sName = sName.Replace(".dxf", "_s" & dThink & ".dxf")
If Not oCompDef.HasFlatPattern Then : oCompDef.Unfold
Else : oCompDef.FlatPattern.Edit : End If
Dim sOut As String = "FLAT PATTERN DXF?AcadVersion=2018" _
& "&InteriorProfileLayer=IV_INTERIOR_PROFILES" _
& "&InteriorProfilesLayerColor=" & sColor & "" _
& "&OuterProfileLayer=IV_EXTERIOR_PROFILES" _
& "&InvisibleLayers=IV_TANGENT" _
& "&SimplifySplines=True" _
& "&BendLayerLineType=37633" _
& "&BendLayerColor=" & sColor & "" _
& "&BendUpLayerLineType=37633" _
& "&BendUpLayerColor=" & sColor & "" _
& "&BendDownLayerLineType=37633" _
& "&BendDownLayerColor=" & sColor & "" _
& "&FeatureProfilesLayerLineType=37633" _
& "&FeatureProfilesLayerColor=" & sColor & "" _
& "&FeatureProfilesUpLayerLineType=37633" _
& "&FeatureProfilesUpLayerColor=" & sColor & "" _
& "&FeatureProfilesDownLayerLineType=37633" _
& "&FeatureProfilesDownLayerColor=" & sColor & ""
oCompDef.DataIO.WriteDataToFile(sOut, sName)
oCompDef.FlatPattern.ExitEdit
End Sub
У 32-му рядку Ви можете вказати колір ліній гибу.
Andrii Humeniuk - CAD Coordinator, Autodesk Certified Instructor
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.
Дуже Вам вдячний. До ідеала не вистачає щоб в назві файла була ще кількість деталей. Як було в першому випадку. Приклад - SR-400.01.302_s6 (кількість деталей).dxf.
Воно і зараз дуже зручно. Коли це робить оператор ЧПУ - він бачить з якого метала йому треба це робить та також, йому потрібно подивитися в спеціфікацію і побачити яку кількість деталей Він повинен зробити (це великий плюс - що він повинен розуміти конструкцію і трішки бути в темі))) Але, якщо зовсім йому це не потрібно, то можна зробити щоб в назві файла була уся інформацфя яка йому потрібна - товщина мателу та кількість деталей.
Додав до назви файлів кількість штук.
Public Sub Main()
Dim oInvApp As Inventor.Application = ThisApplication
oCM = oInvApp.CommandManager
Dim oDoc As Document = oInvApp.ActiveDocument
Dim sFileName As String
Dim sPath As String = CheckFolder(oDoc)
If TypeOf oDoc Is PartDocument Then
If CheckPart(oDoc) Then Exit Sub
sFileName = CheckFullName(oDoc)
Call CreateDXF(oDoc, sPath, sFileName)
Shell("explorer.exe /Open," & sPath, vbNormalFocus)
Else If TypeOf oDoc Is AssemblyDocument Then
Call WorkingWithAssembly(oInvApp, oDoc, sPath)
Else If TypeOf oDoc Is DrawingDocument Then
Dim oDDoc As DrawingDocument = oDoc
If oDDoc.Sheets.Count = 0 Then Exit Sub
Dim oViews As DrawingViews = oDDoc.Sheets(1).DrawingViews
If oViews.Count = 0 Then Exit Sub
Dim oRefDoc As Document = oViews(1).ReferencedDocumentDescriptor.ReferencedDocument
If TypeOf oRefDoc Is AssemblyDocument Then
Call WorkingWithAssembly(oInvApp, oRefDoc, sPath)
Else If TypeOf oRefDoc Is PartDocument Then
If CheckPart(oRefDoc) Then Exit Sub
sFileName = CheckFullName(oRefDoc)
Call CreateDXF(oRefDoc, sPath, sFileName)
Shell("explorer.exe /Open," & sPath, vbNormalFocus)
End If
End If
End Sub
Property oCM As CommandManager
Property sColor As String = "255;255;0" ' yellow
Private Function CheckPart(ByVal oPDoc As Document) As Boolean
Dim sStand As String = oPDoc.PropertySets("Design Tracking Properties")("Catalog Web Link").Value
If sStand = "ДСТУ 8540" Or sStand = "EN 10131" Then Return False
Return True
End Function
Private Function CheckFolder(ByVal oPDoc As Document) As String
Dim sPath As String = System.IO.Path.GetDirectoryName(oPDoc.File.FullFileName) & "\DXF Files"
If Not System.IO.Directory.Exists(sPath) Then System.IO.Directory.CreateDirectory(sPath)
Return sPath
End Function
Private Function CheckFullName(ByVal oPDoc As PartDocument, Optional ByVal iQty As Integer = 0) As String
Dim sFileName As String = System.IO.Path.GetFileNameWithoutExtension(oPDoc.FullFileName)
If iQty = 0 Then : sFileName = "\" & sFileName & ".dxf"
Else : sFileName = "\" & sFileName & " (" & iQty & ").dxf" : End If
Return sFileName
End Function
Private Sub WorkingWithAssembly(ByVal oInvApp As Inventor.Application, ByVal oAsmDoc As AssemblyDocument, ByVal sPath As String)
Dim oRefDocs As DocumentsEnumerator = oAsmDoc.AllReferencedDocuments
Dim oPBar As Inventor.ProgressBar
oPBar = oInvApp.CreateProgressBar(False, oRefDocs.Count, "Exporting DXF...")
oPBar.Message = ("Loading...")
Dim oOccs As ComponentOccurrences = oAsmDoc.ComponentDefinition.Occurrences
For i As Integer = 1 To oRefDocs.Count
oPBar.Message = ("Create DXF files. Progress " & i & " of " & oRefDocs.Count & ".")
oPBar.UpdateProgress
If Not TypeOf oRefDocs(i) Is PartDocument Or CheckPart(oRefDocs(i)) Then Continue For
If Not oRefDocs(i).SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then Continue For
If oOccs.AllReferencedOccurrences(oRefDocs(i)).Count > 0 Then
Dim sName As String = CheckFullName(oRefDocs(i), oOccs.AllReferencedOccurrences(oRefDocs(i)).Count)
Dim oPDoc As PartDocument = oInvApp.Documents.Open(oRefDocs(i).FullFileName, True)
Call CreateDXF(oPDoc, sPath, sName)
oPDoc.Close()
End If
Next i
oPBar.Close()
Shell("explorer.exe /Open," & sPath, vbNormalFocus)
End Sub
Private Sub CreateDXF(ByVal oPDoc As PartDocument, ByVal sPath As String, ByVal sName As String)
Dim oCompDef As SheetMetalComponentDefinition = oPDoc.ComponentDefinition
Dim dThink As Double = Round(oCompDef.Thickness.Value * 10, 3)
If sName.Contains(").dxf") Then
sName = sName.Replace("(", "_s" & dThink & "(")
Else
sName = sName.Replace(".dxf", "_s" & dThink & ".dxf")
End If
sPath = sPath & sName
If Not oCompDef.HasFlatPattern Then : oCompDef.Unfold
Else : oCompDef.FlatPattern.Edit : End If
Dim sOut As String = "FLAT PATTERN DXF?AcadVersion=2018" _
& "&InteriorProfileLayer=IV_INTERIOR_PROFILES" _
& "&InteriorProfilesLayerColor=" & sColor & "" _
& "&OuterProfileLayer=IV_EXTERIOR_PROFILES" _
& "&InvisibleLayers=IV_TANGENT" _
& "&SimplifySplines=True" _
& "&BendLayerLineType=37633" _
& "&BendLayerColor=" & sColor & "" _
& "&BendUpLayerLineType=37633" _
& "&BendUpLayerColor=" & sColor & "" _
& "&BendDownLayerLineType=37633" _
& "&BendDownLayerColor=" & sColor & "" _
& "&FeatureProfilesLayerLineType=37633" _
& "&FeatureProfilesLayerColor=" & sColor & "" _
& "&FeatureProfilesUpLayerLineType=37633" _
& "&FeatureProfilesUpLayerColor=" & sColor & "" _
& "&FeatureProfilesDownLayerLineType=37633" _
& "&FeatureProfilesDownLayerColor=" & sColor & ""
oCompDef.DataIO.WriteDataToFile(sOut, sPath)
oCompDef.FlatPattern.ExitEdit
End Sub
Приємно знати, що Ви розібрались з умовою, що у властивості "WEB Link" має бути листовий стандарт: ДСТУ 8540 або EN 10131.
Якщо є потреба змінити на іншу властивість, Вам потрібно ознайомитись з наступною літературою. На ст. 13 Ви можете побачити перелік властивостей та метод їх отримання. Редагувати рядок 35.
Andrii Humeniuk - CAD Coordinator, Autodesk Certified Instructor
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.
Доброго дня. Все добре працює. Дякую.
Так – трохи розібрався))) Це потужний інструмент і треба хоча б три рядки коду написати самостійно)))
Десь на просторах інтернету знайшов такий файл - може Вам знадобиться (прикріплений файл). Легко шукати та додавати в код. Хоча у Вас, напевно, щось таке подібне є.
За літературу - Окреме Дякую.
Sie finden nicht, was Sie suchen? Fragen Sie die Community oder teilen Sie Ihr Wissen mit anderen.