Export stp from drawing with sheetname

[r.warmerdam]

Hi all,

I'm currently using a code to create seperate pdf's from sheets with the sheetname.

I'm also using a code to create a stp of all parts on different sheets.

Is it possible to combine these codes to create a stp of the parts with the sheetname?

The first sheet of the idw is usually a (weld)assembly; the other sheets are the seperate parts for the assembly. 1 part per sheet. 

Below the code to create a stp of all parts.

Sub Main

'Copy Rev Number from .ipt/.iam to .idw iProperties
modelName = IO.Path.GetFileName(ThisDrawing.ModelDocument.FullFileName)
iProperties.Value("Project", "Revision Number") = iProperties.Value(modelName,"Project", "Revision Number")

	Dim oDDoc As DrawingDocument = ThisApplication.ActiveDocument
	oRefParts = GetAllDrawingParts(oDDoc)
	oRevNum = iProperties.Value("Project", "Revision Number")
	oPath = ThisDoc.Path & "\" & "STP"
	oFolder = oPath
	
	
'Check For the STP folder And create it If it does Not exist
If Not System.IO.Directory.Exists(oFolder) Then
    System.IO.Directory.CreateDirectory(oFolder)
End If

	For Each oObj In oRefParts
		Dim oRefPart As PartDocument = CType(oObj, PartDocument)
		'specify file name for new STEP file
		'first get path & file name, without file extension
			oName = System.IO.Path.GetFileNameWithoutExtension(oRefPart.FullDocumentName)



	'Assembling the file name
	If oRevNum = "-" Then
	oSTEPFile = oFolder & "\" & oName  &   " " &".stp"
	Else
	oSTEPFile = oFolder & "\" & oName  &  "_" & oRevNum & " " &".stp"
	End If

	'now run our sub routine defined below
	ExportToSTEP(oRefPart, oSTEPFile)
	Next
'- - - - - - - - - - - - -
MessageBox.Show("New Files Created in: " & vbLf & oFolder, "iLogic")
'open the folder where the new files are saved
Shell("explorer.exe " & oFolder, vbNormalFocus)
End Sub

Function GetAllDrawingParts(oDrawing As DrawingDocument) As ObjectCollection
	Dim oDocColl As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
	If oDrawing.AllReferencedDocuments.Count = 0 Then Return oDocColl
	For Each oRefDoc As Document In oDrawing.AllReferencedDocuments
		If oRefDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
			oDocColl.Add(oRefDoc)
		End If
	Next
	Return oDocColl
End Function

Sub ExportToSTEP(oDoc As Document, oNewFileName As String)

oPath = ThisDoc.Path

	Dim oSTEP As TranslatorAddIn
	For Each oAddIn As ApplicationAddIn In ThisApplication.ApplicationAddIns
		If oAddIn.DisplayName = "Translator: STEP" Then
			oSTEP = oAddIn
		End If
	Next
	If IsNothing(oSTEP) Then
		MsgBox("STEP Translator Add-in nicht gefunden", vbCritical, "iLogic")
		Exit Sub
	End If

	'create needed variables for translator
	oTO = ThisApplication.TransientObjects
	oContext = oTO.CreateTranslationContext
	oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
	oOptions = oTO.CreateNameValueMap
	oDataMedium = oTO.CreateDataMedium

	oDataMedium.FileName = oNewFileName

	If oSTEP.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
		' Set application protocol.
		 ' 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("Description").Value
		 'oOptions.Value("Organization") = oDoc.PropertySets.Item(2).Item("Company").Value

		'Publish document
		'get STP target folder path
		oFolder = Left(oPath, InStrRev(oPath, "\")) & "7   STEP Dateien"

		'Check for the STP folder and create it if it does not exist
		If Not System.IO.Directory.Exists(oFolder) Then
    		System.IO.Directory.CreateDirectory(oFolder)
		End If
		
		Try
			 oSTEP.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
		Catch
			MsgBox("Etwas ist schief gelaufen, konnte kein STP erstellen", vbOKOnly + vbExclamation, "Export to STEP Error")
		End Try
	End If
	
End Sub

Below the code for creating the pdf per sheet. 

If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
	MsgBox("A Drawing Document must be active for this rule (" & iLogicVb.RuleName & ") to work. Exiting.",vbOKOnly+vbCritical, "WRONG DOCUMENT TYPE")
	Exit Sub
End If
Dim oDrawing As DrawingDocument = ThisDrawing.Document
Dim oSheetsCount As Integer = oDrawing.Sheets.Count

Dim oInstructions As String = "Enter the sheet numbers you want to publish to PDF." & vbCrLf & _
"Use commas, to separate individual sheet numbers, and to separate sheet ranges." & vbCrLf & _
"Use a dash (-) between two numbers to specify a sheet range." & vbCrLf & _
"NO SPACES!"
Dim oInputSheets As String = InputBox(oInstructions, "Sheets To Publish", "1-" & oSheetsCount)
'split that string up into an array of individual strings so they can be more easily interpreted
Dim oSheetRanges() As String = Split(oInputSheets, ",")
Dim oSheetCol As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
Dim oRangeStart, oRangeEnd As Integer
For Each oSR As String In oSheetRanges
	'check to see if the string includes the "-" character
	If oSR.Contains("-") Then
		'it is a sheet range, so get the two numbers
		oRangeStart = CInt(Split(oSR, "-")(0))
		oRangeEnd = CInt(Split(oSR, "-")(1))
		For i As Integer = oRangeStart To oRangeEnd
			oSheetCol.Add(oDrawing.Sheets.Item(i))
		Next
	Else
		oSheetCol.Add(oDrawing.Sheets.Item(CInt(oSR)))
	End If
Next

Dim oPath As String = IO.Path.GetDirectoryName(oDrawing.FullFileName)
Dim oFileName As String = IO.Path.GetFileNameWithoutExtension(oDrawing.FullFileName)

'get PDF target folder path
Dim oFolder As String = ThisDoc.Path & "\" & "PDF"

'Check For the PDF folder And create it If it does Not exist
If Not System.IO.Directory.Exists(oFolder) Then
    System.IO.Directory.CreateDirectory(oFolder)
End If

Dim oPDFAddIn As TranslatorAddIn = ThisApplication.ApplicationAddIns.ItemById _
("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism 
Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
Dim oDataMedium As DataMedium = ThisApplication.TransientObjects.CreateDataMedium

oOptions.Value("All_Color_AS_Black") = 0
oOptions.Value("Remove_Line_Weights") = 0
oOptions.Value("Vector_Resolution") = 400
oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintCurrentSheet

Dim oSheet As Sheet
Dim lPos As Long
Dim rPos As Long
Dim sLen As Long
Dim sSheetName As String
Dim iSheetNumber As Integer

'step through each drawing sheet
For Each oSheet In oSheetCol
	oSheet.Activate
	'find the seperator in the sheet name:number
	lPos = InStr(oSheet.Name, ":")
	'find the number of characters in the sheet name
	sLen = Len(oSheet.Name)
	'find the sheet name
	sSheetName = Left(oSheet.Name, lPos -1)
	'find the sheet number
	iSheetNumber = Right(oSheet.Name, sLen -lPos)
	
	'Set the PDF target file name
'	oDataMedium.FileName = oFolder & "\" & oFileName &"_" & sSheetName & " " & iSheetNumber  & ".pdf"
	oDataMedium.FileName = oFolder & "\" & oFileName & "_" & sSheetName & " " & ".pdf"
	
	'Publish document
	oPDFAddIn.SaveCopyAs(oDrawing, oContext, oOptions, oDataMedium)
Next
'Activate the first sheet again
oDrawing.Sheets.Item(1).Activate

MessageBox.Show("New Files Created in: " & vbLf & oFolder, "iLogic")
'open the folder where the new files are saved
Shell("explorer.exe " & oFolder, vbNormalFocus)