Product Design & Manufacturing – Українською
Дана гілка форуму є основною для теми дизайну виробів та їх виробництва. В ній пропонуємо обговорювати застосування програмних продуктів, що входять до Autodesk Product Design & Manufacturing Collection, як Inventor, Vault, Fusion (раніше відомий як Fusion 360), так і дотичні до них, як PowerMill, Netfabb, Moldflow та інші. Діліться знаннями, запитуйте й отримуйте відповіді, та читайте найпопулярніші теми по цим програмним продуктам.
abbrechen
Suchergebnisse werden angezeigt für 
Anzeigen  nur  | Stattdessen suchen nach 
Meintest du: 

Inventor. Експорт плоских та гнутих деталей в dxf

9 ANTWORTEN 9
GELÖST
Antworten
Nachricht 1 von 10
DmytroMukhin
964 Aufrufe, 9 Antworten

Inventor. Експорт плоских та гнутих деталей в dxf

Всім привіт!

Дякую за пропозицію від @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




Менеджер спільноти Autodesk | Autodesk Community Manager
9 ANTWORTEN 9
Nachricht 2 von 10
Andrii_Humeniuk
als Antwort auf: DmytroMukhin

Вітаю @DmytroMukhin .

Хоча я ще не стикався з цим питанням на українській гілці форуму, але на англійській гілці, безперечно, експорт в форматі DXF є одним з найрозповсюдженіших питань.

Зазвичай, людям потрібно знайти яке-небудь рішення для конкретної задачі, наприклад, експорт креслення, збірки чи деталі. Одного разу я бачив навіть запитання щодо експорту найбільшої площини на плоскій деталі. Тому, аби повністю розібратися з цим питанням, я хочу поділитися макросом, який використовую для цієї мети.

Особливості:

 

  1. Запускати можна в Кресленні, Збірці, Деталі.
  2. Макрос розуміє різницю між SheetMetal деталю та звичайною. В другому випадку експортується найбільша площина*;
  3. У випадку, якщо це збірка до назви додається потрібна кількість.

Для того щоб не експортувались всі деталі зі збірки, у макросі є селектор 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.

EESignature

Nachricht 3 von 10
DmytroMukhin
als Antwort auf: Andrii_Humeniuk

Дякую!

Можливо, буде цікаво про це почитати @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




Менеджер спільноти Autodesk | Autodesk Community Manager
Nachricht 4 von 10

Добрий день.
А для якої версії це написано? В 2023 отримую таке повідомлення...чи я щось не вірно роблю?

Yaroslavshelest_0-1692444152694.png

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
EESignature

Nachricht 5 von 10

Вітаю @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.

EESignature

Nachricht 6 von 10
anton.mashkin.ua
als Antwort auf: DmytroMukhin

'Призначення активного документа збірка
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, то ці лінії в потрібному слої і його можна вимкнути, але мені здається, що це для оператора ЧПУ не потрібно. Може я помиляюсь та їм (операторам) зручніше так. Якщо хтось є з досвідом - підкажіть як краще. 

Nachricht 7 von 10
Andrii_Humeniuk
als Antwort auf: DmytroMukhin

Вітаю @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.

EESignature

Nachricht 8 von 10
anton.mashkin.ua
als Antwort auf: DmytroMukhin

Дуже Вам вдячний. До ідеала не вистачає щоб в назві файла була ще кількість деталей. Як було в першому випадку. Приклад - SR-400.01.302_s6 (кількість деталей).dxf. 

Воно і зараз дуже зручно. Коли це робить оператор ЧПУ - він бачить з якого метала йому треба це робить та також, йому потрібно подивитися в спеціфікацію і побачити яку кількість деталей Він повинен зробити (це великий плюс - що він повинен розуміти конструкцію і трішки бути в темі))) Але, якщо зовсім йому це не потрібно, то можна зробити щоб в назві файла була уся інформацфя яка йому потрібна - товщина мателу та кількість деталей.  

Nachricht 9 von 10

Додав до назви файлів кількість штук.

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.

EESignature

Nachricht 10 von 10

Доброго дня. Все добре працює. Дякую.

Так – трохи розібрався))) Це потужний інструмент і треба хоча б три рядки коду написати самостійно)))

Десь на просторах інтернету знайшов такий файл - може Вам знадобиться (прикріплений файл). Легко шукати та додавати в код. Хоча у Вас, напевно, щось таке подібне є.

За літературу - Окреме Дякую. 

Sie finden nicht, was Sie suchen? Fragen Sie die Community oder teilen Sie Ihr Wissen mit anderen.

In Foren veröffentlichen