Create stepfile off parts from DWG.

[TechInventor20]

Hello,

I would like to make stepfiles of all the parts that I have on my drawing. It is most likely that they are all flat patterns. I allready got the following code put together. could someone see where the hickup is? 

C_schijf_txt = "C:\Inventor\Orderpath.txt"
C_Schijf_Route = "C:\Inventor\Ordernummer.txt"
Dim Cschijf_route As String

Dim Kschijf As String = "K:\"

Dim Ordernummer As String 
Dim Tek_Ordernummer As String
Tek_Ordernummer = iProperties.Value("Custom", "02-Ordernummer")
Tek_ordernummer_teknummer = iProperties.Value("Custom", "02-Tekeningnummer")
MsgBox(Tek_Ordernummer)



	oRead = System.IO.File.OpenText(C_schijf_txt)
	Cschijf_route = oRead.ReadToEnd()
'	CStr(Left(iProperties.Value("Project","Part Number"),4))
	oRead.Close()

MsgBox(Cschijf_route)

If Cschijf_route.Contains(Tek_Ordernummer) Then
	Ordernummer = Tek_Ordernummer
	Else
		MsgBox("De ordernummers komen niet overeen, je zit in een verkeerd project." & vbLf & "Pas dit aan!")
		Exit Sub
End If
	
	
Dim Split() As String = Cschijf_route.Split("\")
Dim Klantnaam As String
Dim Jaartal As String
Dim K_Schijfroute As String

Klantnaam = Split(5)
Jaartal = Split(6)

K_Schijfklantmap = Kschijf & Jaartal & "\" & Klantnaam


            For Each Mapname As String In IO.Directory.GetDirectories(K_Schijfklantmap, Ordernummer & " " & "*", IO.SearchOption.AllDirectories)

                If Mapname.Contains(Ordernummer) Then
                    'The next line of code gets only file extensions from searched directories and subdirectories
                    K_Schijfroute = IO.Path.GetFullPath(Mapname)
                    'writer.WriteLine(fName)
                    'MsgBox(Mapnaam)
                    'flocatie = IO.Path.GetDirectoryName(filename)
                    'MsgBox(flocatie)
                End If
            Next

Dim Stepfile_Flatpatternmap As String = (K_Schijfroute & "\" & "02-Inkoop\" & "Teknr " & Tek_ordernummer_teknummer )	
MsgBox(Stepfile_Flatpatternmap)
Dim Yesnovraag As String = MessageBox.Show("Stepfile maken van de onderdelen?" & vbLf & "De stepfiles komen op de K-schijf onder de 01-Inkoop map.","Stepfile generator",MessageBoxButtons.YesNo)
If Yesnovraag = vbNo Then
	Exit Sub
Else
		If Not System.IO.Directory.Exists(Stepfile_Flatpatternmap) Then 
    	System.IO.Directory.CreateDirectory(Stepfile_Flatpatternmap)
		Else
			MsgBox("Zijn al stepfiles van gemaakt.")
			Exit Sub
		End If
End If



	Dim oDrawDoc As DrawingDocument
 oDrawDoc = ThisApplication.ActiveDocument

Dim oSheet As Sheet
oSheet = oDrawDoc.ActiveSheet

' select drawing views on active sheet
Dim oDrawView As DrawingView

For Each oDrawView In oSheet.DrawingViews	
	
	Dim oModelDoc As Document = oDrawView.ReferencedDocumentDescriptor.ReferencedDocument

	Dim oViewModelName As String = oModelDoc.DisplayName
	Dim oFullFilePath As String = oModelDoc.FullFileName

	Dim oFolderPath As String = Left(oFullFilePath, (InStrRev(oFullFilePath, "\", -1, vbTextCompare) -1))
	
	
	
''	MessageBox.Show("DisplayName: " & oViewModelName)
''	MessageBox.Show("FullFilename: " & oFullFilePath)
''	MessageBox.Show("FolderPath: " & oFolderPath )
	
	Dim oDoc As Document = ThisApplication.Documents.Open(oFullFilePath)
	
'	auto = iLogicVb.Automation
			Try
'			auto.RunRule(oDoc, sRuleName)
			iLogicVb.RunExternalRule( "AuTTeK\TDV\Save_as_stepfile")
'			iLogicVb.Automation.RunExternalRule(oDoc,"Save_as_stepfile")
			Catch
				MessageBox.Show("Cannot find a rule with the name " & "Save_as_stepfile" & vbLf & "Please try again.", "Open and run")
			End Try
			
Dim Stepfile_Flatpatternmap1 As String = (K_Schijfroute & "\" & "02-Inkoop\" & "Teknr " & Tek_ordernummer_teknummer )	

Dim Posnr As String = iProperties.Value(oDoc.name,"Custom", "03-Posnr")
Dim Hoofdtek As String = iProperties.Value(oDoc.name,"Custom", "03-Hoofdtekening")


' Get the STEP translator Add-In.
Dim oSTEPTranslator As TranslatorAddIn
oSTEPTranslator = ThisApplication.ApplicationAddIns.ItemById _
("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
Dim oContext As TranslationContext
oContext = ThisApplication.TransientObjects.CreateTranslationContext
Dim oOptions As NameValueMap
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
 
If oSTEPTranslator.HasSaveCopyAsOptions(ThisApplication.ActiveDocument _
, oContext, oOptions) Then
    oOptions.Value("ApplicationProtocolType") = 3
    oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
    Dim oData As DataMedium
    oData = ThisApplication.TransientObjects.CreateDataMedium
    
    ' Set export name of STEP file
    oData.FileName = (Stepfile_Flatpatternmap1 & "\" & Hoofdtek & "_" & Posnr &".ipt")
oSTEPTranslator.SaveCopyAs(ThisApplication.ActiveDocument, oContext _
, oOptions, oData)
End If
 
' End of export code ***********************************************
 
' Ask user if they want to open the export folder
OpenFolder = MessageBox.Show("Export successful! " & _
"- open containing folder now?", "Cadline iLogic", _
MessageBoxButtons.YesNo, _
MessageBoxIcon.Question,MessageBoxDefaultButton.Button1)
 
If OpenFolder = vbYes Then
    Process.Start("explorer.exe", ThisDoc.Path)
Else ' User says continue
    'Return
End If

	
	Next

The problem starts when I open the files one by one and then need a Ipropertie in that file, but I cant get it because the rule is still in the "DWG" file. 

[WCrihfield · Accepted solution]

It's a bit difficult to follow your rule, due to language difference, but since you said that the problem seems to be in getting the iProperties from the model document and not from the drawing document, I have a suggestion for you.

Try changing these two lines:

Dim Posnr As String = iProperties.Value(oDoc.name,"Custom", "03-Posnr")
Dim Hoofdtek As String = iProperties.Value(oDoc.name,"Custom", "03-Hoofdtekening")

To something like:

Dim Posnr As String = iProperties.Value(oDoc.DisplayName,"Custom", "03-Posnr")
Dim Hoofdtek As String = iProperties.Value(oDoc.DisplayName,"Custom", "03-Hoofdtekening")

or just access them the long way, to be sure, like this:

Dim Posnr As String = oDoc.PropertySets.Item("Inventor User Defined Properties").Item("03-Posnr").Value
Dim Hoofdtek As String = oDoc.PropertySets.Item("Inventor User Defined Properties").Item("03-Hoofdtekening").Value

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

If you have time, please... Vote For My IDEAS 💡or you can Explore My CONTRIBUTIONS

Inventor 2021 Help | Inventor Forum | Inventor Customization Forum | Inventor Ideas Forum

[TechInventor20]

Works like a charm! thank you!!