Message 1 of 8
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
We currently have a rule which goes through the parts in an assembly and exports .step & .dxf files for any parts that need to be sent to a supplier for manufacture. The code we have works great for what we need it to do.
We have recently installed Inventor 2022.1 and we are starting to use models states to show pre-production parts as well as the final part e.g. a hollow section that we buy in blank but then drill holes out in the workshop. What I would like is for the rule to be tweaked so that before exporting each part, it will check if it has a model state named 'Pre-Production'. If it does then it should export the .step & .dxf file using that model state. If its not there, then just export using the master model state (as not all parts require a pre-production model state).
I have attached our current code.
Thanks in advance.
Sub Main()
Dim ans As String
ans = MessageBox.Show("Before running this rule, please check the following:" + vbCrLf + "" + vbCrLf + "For parts where the face side is critical e.g. polished stainless steel, please make sure to create a flat pattern manually or define an A-Side" + vbCrLf + "" + vbCrLf + "Inventor will ask you to check out any files that are not checked out that need to be flat patterned.", "Caution", MessageBoxButtons.OKCancel, MessageBoxIcon.Asterisk, MessageBoxDefaultButton.Button1)
If ans = vbCancel Then
Exit Sub
End If
'CREATE FOLDER / CHECK IF EXISTS
Dim fdObj As Object
fdObj = CreateObject("Scripting.FileSystemObject")
If fdObj.FolderExists("C:\KIT OF PARTS") Then
'DO NOTHING
Else
fdObj.CreateFolder("C:\KIT OF PARTS")
End If
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
TraverseAssembly(oAsmDoc.ComponentDefinition.Occurrences, 1)
MessageBox.Show("KIT OF PARTS SAVED IN C:\KIT OF PARTS", "Title")
fOPath = "C:\KIT OF PARTS\"
Call Shell("explorer.exe " & fOPath, vbNormalFocus)
End Sub
Sub TraverseAssembly(Occurrences As ComponentOccurrences, Level As Integer)
Dim oOcc As ComponentOccurrence
'STEP CREATOR
Dim oContext As TranslationContext
oContext = ThisApplication.TransientObjects.CreateTranslationContext
Dim oOptions As NameValueMap
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
Dim oSTEPTranslator As TranslatorAddIn
oSTEPTranslator = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
If oSTEPTranslator Is Nothing Then
MessageBox.Show("Could not access STEP translator.", "ERROR")
Exit Sub
End If
For Each oOcc In Occurrences
If oOcc.Suppressed Then
'DONT CREATE STEP FILE FOR SUPPRESSED FILES
Else 'not suppressed
If oOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
'DONT CREATE STEP FILE FOR ASSEMBLY FILES
Call TraverseAssembly(oOcc.SubOccurrences, Level + 1)
Else 'NOT ASSY
If oOcc.BOMStructure = 51972 Or oOcc.BOMStructure = 51971 Then
'PART SET TO REF.OR PHANTOM DO NOT CREATE STEP
Else
'CHECK IF PARAMETER EXISTS
Try
If oOcc.Definition.Document.PropertySets.Item("Inventor User Defined Properties").Item("Purchased").Value = "-" And _
oOcc.Definition.Document.PropertySets.Item("Inventor User Defined Properties").Item("Stores").Value = "-" And _
oOcc.Definition.Document.PropertySets.Item("Inventor User Defined Properties").Item("Laser Stock").Value = "-" Then
'CHECK IF ALREADY EXIST
DPS = ThisDoc.Document.PropertySets.Item("Design Tracking Properties")
ISI = ThisDoc.Document.PropertySets.Item("Inventor Summary Information")
Dim PN As String
Dim REVI As String
PN = oOcc.Definition.Document.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
REVI = oOcc.Definition.Document.PropertySets.Item("Inventor Summary Information").Item("Revision Number").Value
'CHECK IF STEP ALREADY EXISTS
If Not Dir("C:\KIT OF PARTS\" & PN & " - " & REVI & ".stp", vbDirectory) = vbNullString Then
'FILE ALREADY EXISTS - SKIP
Else
'OPEN FILE
oNewDoc = ThisApplication.Documents.Open(oOcc.Definition.Document.FullFileName, True)
If TypeOf ThisApplication.ActiveDocument.ComponentDefinition Is SheetMetalComponentDefinition Then
'FLAT PATTERN FUNCTIONS
Dim oDoc As PartDocument
oDoc = ThisApplication.ActiveDocument
Dim oCompDef As SheetMetalComponentDefinition
oCompDef = oDoc.ComponentDefinition
If oCompDef.HasFlatPattern = False Then
oCompDef.Unfold
Else
oCompDef.FlatPattern.Edit
End If
'FLAT PATTERN DXF Settings
Dim sOut As String
Dim sPATH As String
sOut = "FLAT PATTERN DXF?AcadVersion=2004&RebaseGeometry=True&OuterProfileLayer=0&OuterProfileLayerColor=0;0;0&InteriorProfilesLayer=0&InteriorProfilesLayerColor=0;0;0;IV_OUTER_PROFILE;IV_INTERIOR_PROFILES;IV_FEATURE_PROFILES;IV_FEATURE_PROFILES_DOWN;IV_ALTREP_FRONT;IV_ALTREP_BACK;IV_ROLL_TANGENT;IV_ROLL&InvisibleLayers=IV_BEND;IV_BEND_DOWN;IV_TANGENT;IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN;IV_ARC_CENTERS;IV_UNCONSUMED_SKETCHES"
Dim sFname As String
sFname = "C:\KIT OF PARTS\" & PN & " - " & REVI & ".DXF"
'Export the DXF and fold the model back up
oCompDef.DataIO.WriteDataToFile( sOut, sFname)
Dim oSMDef As SheetMetalComponentDefinition
oSMDef = oDoc.ComponentDefinition
oSMDef.FlatPattern.ExitEdit
'END OF FLAT PATTERN FUNCTIONS
End If
If oSTEPTranslator.HasSaveCopyAsOptions(ThisApplication.ActiveDocument, oContext, oOptions) Then
oOptions.Value("ApplicationProtocolType") = 3
oContext.Type = kFileBrowseIOMechanism
Dim oData As DataMedium
oData = ThisApplication.TransientObjects.CreateDataMedium
oData.FileName = "C:\KIT OF PARTS\" & PN & " - " & REVI & ".stp"
'Publish document.
Call oSTEPTranslator.SaveCopyAs(oNewDoc, oContext, oOptions, oData)
End If
'Check for flat pattern >> create one if needed
oNewDoc.Close
End If
End If
Catch
'MessageBox.Show("PARAMETER MISSING", oOcc.Definition.Document.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value)
End Try
End If
End If
End If
Next
End Sub
Solved! Go to Solution.
