export all SheetMetalparts in Assembly as STP

[jwoutersJC4LN]

Hi,

I've a question about saving as STP. file.

Does anyone have a code for saving all the Sheetmetalparts in an Assembly, which have the Ipropertie, FileSubtype - Sheetmetal, to STP? 

Saving them in the same folder as the original Part and save them as folded model, with the same name as the part.

Found different code's online but all the codes i've found make only one STP from only the assembly.

Thanks!

[jwoutersJC4LN]

Found a code online and this one is working for me.

But i want to add something extra. 

When a part Subtype is Modeling, i has to make a STP. in some cases as well. 

When the Ipropertie  Project,Authority is "laser", i has to make a STP. from this part as well. 

I this possible to add in this code or maybe an extra code?

'check that the active document is an assembly file
If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
	MessageBox.Show("This Rule " & iLogicVb.RuleName & " only works on Assembly Files.", "WRONG DOCUMENT TYPE",MessageBoxButtons.OK,MessageBoxIcon.Error)
	Return
End If

'define the active document as an assembly file
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) -4)

'get user input
RUsure = MessageBox.Show ( _
"This will create DXF files and STEP Files for all of the assembly components that are sheet metal." _
& vbLf & "This rule expects that the part file is saved." _
& vbLf & " " _
& vbLf & "Are you sure you want to create DXF and STEP files for all of the assembly components?" _
& vbLf & "This could take a while.", "iLogic - Export Sheet Metal ",MessageBoxButtons.YesNo)
If RUsure = vbNo Then
Return
Else
End If
oPath = ThisDoc.Path
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap

'get DXF target folder path
oFolderDXF = oPath & "\" & "DXF Files" & "\" 
oFolderSTEP = oPath & "\" & "STEP Files" & "\" 

'- - - - - - - - - - - - -Component - - - - - - - - - - - -
'look at the files referenced by the assembly
Dim oRefDocs As DocumentsEnumerator
oRefDocs = oAsmDoc.AllReferencedDocuments
Dim oRefDoc As Document
'work the the drawing files for the referenced models
'this expects that the model has been saved
For Each oRefDoc In oRefDocs
iptPathName = Left(oRefDoc.FullDocumentName, Len(oRefDoc.FullDocumentName) - 3) & "ipt"
'check that model is saved
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
Dim oCompDef As SheetMetalComponentDefinition
oCompDef = oDrawDoc.ComponentDefinition
	
If oCompDef.Bends.Count = 0 Then

'Check for the DXF folder and create it if it does not exist
If Not System.IO.Directory.Exists(oFolderDXF) Then
System.IO.Directory.CreateDirectory(oFolderDXF)
End If

'Set the DXF target file name
oDataMedium.FileName = oFolderDXF & "\" & oFileName & ".dxf"

If oCompDef.HasFlatPattern = False Then
oCompDef.Unfold
Else
oCompDef.FlatPattern.Edit
End If

Dim sOut As String
sOut = "FLAT PATTERN DXF?AcadVersion=2004&OuterProfileLayer=0&OuterProfileLayerColor=0;0;0&InteriorProfilesLayer=0&InteriorProfilesLayerColor=0;0;0&InvisibleLayers=IV_TANGENT;IV_ARC_CENTERS;IV_BEND;IV_BEND_UP;IV_BEND_DOWN;IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN;IV_TOOL_CENTER_UP;IV_FEATURE_PROFILES;IV_FEATURE_PROFILES_UP;IV_FEATURE_PROFILES_DOWN;IV_ALTREP_FRONT;IV_ALTREP_BACK;IV_UNCONSUMED_SKETCHES;IV_ROLL_TANGENT;IV_ROLL" 
oCompDef.DataIO.WriteDataToFile( sOut, oDataMedium.FileName)
oCompDef.FlatPattern.ExitEdit

End If
Catch
End Try 

Try
Dim oCompDef As SheetMetalComponentDefinition
oCompDef = oDrawDoc.ComponentDefinition
If oCompDef.Bends.Count < 30 Then

'Check for the STEP folder and create it if it does not exist
If Not System.IO.Directory.Exists(oFolderSTEP) Then
System.IO.Directory.CreateDirectory(oFolderSTEP)
End If

'Set the STEP target file name
oDataMedium.FileName = oFolderSTEP & "\" & oFileName & ".stp"

oDrawDoc.SaveAs(oFolderSTEP & "\" & oFileName & (".stp") , True)
End If
Catch
End Try
oDrawDoc.Close
End If


Next

[WCrihfield]

Hi @jwoutersJC4LN.  I am not sure what options you want set to which values when exporting those parts out as STP files, so I left all the options in this code example commented out for now.  You can still see them in the code, down within the 'ExportToSTEP' Sub routine (Lines 40 through 46), so you can delete the apostrophe from the front of any of those lines that you want to use, and can change the value being set to them however you want.  When checking the iProperties of regular (not sheet metal) parts, I was not sure if both properties need have that same "laser" value before exporting, or if only one of them has that value, it is OK to export it.  You were not very clear there.

Sub Main
	Dim oInvApp As Inventor.Application = ThisApplication
	Dim oADoc As AssemblyDocument = TryCast(ThisDoc.Document, Inventor.AssemblyDocument)
	If oADoc Is Nothing Then Return
	For Each oRefDoc As Inventor.Document In oADoc.AllReferencedDocuments
		If (Not TypeOf oRefDoc Is PartDocument) Then Continue For
		Dim oRefPDoc As PartDocument = oRefDoc
		Dim sSTP_File As String = System.IO.Path.ChangeExtension(oRefPDoc.FullFileName, ".stp")
		If (TypeOf oRefPDoc.ComponentDefinition Is SheetMetalComponentDefinition) Then
			ExportToSTEP(oRefPDoc, sSTP_File)
		Else 'a part, but not sheet metal
			Dim sProject As String = oRefPDoc.PropertySets.Item(3).Item(3).Value 'Project
			Dim sAuthority As String = oRefPDoc.PropertySets.Item(3).Item(26).Value 'Authority
			If sProject = "laser" Or sAuthority = "laser" Then
				ExportToSTEP(oRefPDoc, sSTP_File)
			End If
		End If
	Next
End Sub

Sub ExportToSTEP(oDoc As Document, sNewFullFileName As String)
	Dim oSTEP As TranslatorAddIn
	oSTEP = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
	Dim oTO As TransientObjects = ThisApplication.TransientObjects
	Dim oContext As TranslationContext = oTO.CreateTranslationContext
	oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
	Dim oOptions As NameValueMap = oTO.CreateNameValueMap
	Dim oDataMedium As DataMedium = oTO.CreateDataMedium
	If System.IO.File.Exists(sNewFullFileName) Then
		Dim oAns As MsgBoxResult = MsgBox("A STEP file with this name already exists." & vbCrLf &
		sNewFullFileName & vbCrLf & _
		"Do you want to overwrite it with this new one?", vbYesNo + vbQuestion + vbDefaultButton2, "STEP FILE EXISTS")
		If oAns = MsgBoxResult.No Then Exit Sub
	End If
	'<<< this is where the full path and file name of the exported file is set >>>
	oDataMedium.FileName = sNewFullFileName
	If oSTEP.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
		' 2 = AP 203 - Configuration Controlled Design
		' 3 = AP 214 - Automotive Design
		'oOptions.Value("ApplicationProtocolType") = 3
		'oOptions.Value("IncludeSketches") = True
		'oOptions.Value("export_fit_tolerance") = .000393701  'minimum
		'oOptions.Value("Author") = ThisApplication.GeneralOptions.UserName
		'oOptions.Value("Authorization") = ""
		'oOptions.Value("Description") = oDoc.PropertySets.Item(3).Item(14).Value 'Description
		'oOptions.Value("Organization") = oDoc.PropertySets.Item(2).Item(3).Value 'Company
		Try
			oSTEP.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
		Catch
			Logger.Error("Error exporting following document to STEP:" & vbCrLf & oDoc.FullDocumentName)
		End Try
	End If
End Sub

If this solved your problem, or answered your question, please click ACCEPT SOLUTION .
Or, if this helped you, please click (LIKE or KUDOS) 👍.

[jwoutersJC4LN]

Thanks so far! gonna try this one 🙂