- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi all,
Using Inventor Pro 2025.0.1
We have an ilogic rule for saving out dxf, pdf and step files, which we run only from inside a dwg of a sheet metal ipt that has folds. We've had the rule a while and it's been proven but recently I was asked to modify it to include the revision number on the end of the file names when saved.
What I've got works, but there's one niggle I'd like to iron out.
When it saves the step file, it is creating an extra folder and saving the step file in there. To clarify with an example, lets say I have a dwg named CT10-341 and an ipt of the same name.
The dxf and pdf both save to this path: V:\3D Data\DXF\Design Office dxfs - Steves\CT10-341 REV 2 (.dxf and .pdf accordingly).
However, the STEP file is saving to this path: V:\3D Data\DXF\Design Office dxfs - Steves\CT10-341\CT10-341 REV 2.stp
I'm a total amateur with ilogic and haven't any real experience of coding. Generally I copy code from what I find on here, so I don't always understand what's going on I'm afraid! I recognise that I'm defining the path by using the filename without extension and then asking for the new file to use that path and add the new filename with revision.
strFolder = "V:\3D Data\DXF\Design Office dxfs - Steves\" & ThisDoc.FileName(False) 'without extension ThisDoc.Document.SaveAs(strFolder & (" REV ") & sRevNumb & (".pdf"), True)
strFolder = "V:\3D Data\DXF\Design Office dxfs - Steves\" & ThisDoc.FileName(False) 'without extension ThisDoc.Document.SaveAs(strFolder & (" REV ") & sRevNumb & (".dxf"), True)
That same code works for both the dxf and pdf sections but if I try it with the STEP file, it throws an error, pointing to the final STEPTranslator line:
strFolder = "V:\3D Data\DXF\Design Office dxfs - Steves\" & ThisDoc.FileName(False) 'without extension ThisDoc.Document.SaveAs(strFolder & (" REV ") & sRevNumb & (".stp"), True)
I figured out that this works:
strFolder = "V:\3D Data\DXF\Design Office dxfs - Steves\" & ThisDoc.FileName(False) 'without extension oData.FileName = strFolder & oStepFileName & " REV " & sRevNumb & ".stp"
But it doubles up the filename. In the example above my new step file is named CT10-341CT10-341 REV 2.stp.
So I now have this, which gives me that extra folder level.
strFolder = "V:\3D Data\DXF\Design Office dxfs - Steves\" & ThisDoc.FileName(False) 'without extension oData.FileName = strFolder & "\" & oStepFileName & " REV " & sRevNumb & ".stp"
If anyone can point me in the right direction please, I'd be grateful. Please see my complete code below.
'Declare using subroutines and define the start of the Main section of code Sub Main() '---------------------------------------Below code checks the Part Number iProperty against the FileName--------- oDoc = ThisDoc.FileName(False) PartNumber = iProperties.Value("Project", "Part Number") If oDoc = PartNumber Then Call Saving() Else Try oProp = iProperties.Value("Custom", "NotFileName") Return Return Catch i = MessageBox.Show("Drawing iProperty Part Number does NOT match filename. Would you like it to match?","My iLogic Dialog",MessageBoxButtons.YesNo,MessageBoxIcon.Hand ,MessageBoxDefaultButton.Button1) If i = MsgBoxResult.Yes Then iProperties.Value("Project", "Part Number") = oDoc Call DeleteCustomiProp() Call Saving() ElseIf i = MsgBoxResult.No Then iProperties.Value("Custom", "NotFileName") = "No" Call DeleteCustomiProp() Call Saving() End If End Try End If 'Define the end of the Main section of code End Sub Sub DeleteCustomiProp() 'define list of custom properties to delete Dim MyArrayList As New ArrayList MyArrayList.Add("NotFileName") 'define custom property collection oCustomPropertySet = ThisDoc.Document.PropertySets.Item("Inventor User Defined Properties") 'look at each property in the collection For Each oCustProp In oCustomPropertySet 'check property name against the list you want to delete If MyArrayList.Contains(oCustProp.name)Then 'delete the custom iProperty oCustProp.Delete Else 'skip it End If Next End Sub Sub Saving() 'Activate Sheet 1 for creating pdf ActiveSheet = ThisDrawing.Sheet("Sheet:1") Dim oDraw As DrawingDocument = ThisDoc.Document If TypeOf oDraw.AllReferencedDocuments.Item(1) Is PartDocument Then Dim oDoc1 As PartDocument = oDraw.AllReferencedDocuments.Item(1) Dim sRevNumb As String = oDoc1.PropertySets.Item("Inventor Summary Information").Item("Revision Number").Expression strFolder = "V:\3D Data\DXF\Design Office dxfs - Steves\" & ThisDoc.FileName(False) 'without extension ThisDoc.Document.SaveAs(strFolder & (" REV ") & sRevNumb & (".pdf"), True) End If 'Make sure 2nd sheet is named "FLAT" to enable save copy as dxf Dim sInput1 As String sInput1 = "FLAT" Dim sInput2 As String sInput2 = "DXF" Dim sShName As String Dim sShNum As String Dim oSheet As Sheet Dim lPos As Long Dim lLen As Long For Each oSheet In ThisApplication.ActiveDocument.Sheets lPos = InStr(oSheet.Name, ":") 'position of the colon lLen = Len(oSheet.Name) 'length of sheet name sShName = Left(oSheet.Name, lPos -1) 'string left of the colon sShNum = Right(oSheet.Name, lLen -lPos ) 'string right of the colon If sShNum = 2 Then oSheet.Name = sInput1 End If Next 'Activate Sheet 2, which should have the dxf on ActiveSheet = ThisDrawing.Sheet("FLAT:2") ' Set a reference to the drawing document. ' This assumes a drawing document is active. Dim oDrawDoc As DrawingDocument oDrawDoc = ThisApplication.ActiveDocument ' Set a reference to the active sheet. Dim oActiveSheet As Sheet oActiveSheet = oDrawDoc.ActiveSheet 'get 1st view on active sheet Dim oView As DrawingView oView = oActiveSheet.DrawingViews(1) 'set view scale to 1:1 ActiveSheet.View(oView.Name).Scale = 1 'add a margin value oMargin = 100.0 'mm 'get width, 'and add margin Dim oWidth As Double oWidth = (ActiveSheet.View(oView.Name).Width) + oMargin 'get Height, 'and add margin Dim oHeight As Double oHeight = (ActiveSheet.View(oView.Name).Height) + oMargin If oView.Width < oView.Height Then 'resize the view ActiveSheet.ChangeSize(oWidth, oHeight , moveBorderItems := True) 'center the view ActiveSheet.View(oView.Name).SetCenter(oWidth/2,oHeight/2) 'change sheet Orientation ThisApplication.ActiveDocument.ActiveSheet.Orientation = _ PageOrientationTypeEnum.kPortraitPageOrientation Else If oView.Height < oView.Width Then 'resize the view ActiveSheet.ChangeSize(oHeight, oWidth, moveBorderItems := True) 'center the view ActiveSheet.View(oView.Name).SetCenter(oWidth/2,oHeight/2) 'change sheet Orientation ThisApplication.ActiveDocument.ActiveSheet.Orientation = _ PageOrientationTypeEnum.kLandscapePageOrientation Else 'width and height are equal 'resize the view ActiveSheet.ChangeSize(oHeight, oHeight, moveBorderItems := True) 'center the view ActiveSheet.View(oView.Name).SetCenter(oHeight/2, oHeight/2) End If 'zoom all ThisApplication.ActiveView.Fit Dim oDraw1 As DrawingDocument = ThisDoc.Document If TypeOf oDraw1.AllReferencedDocuments.Item(1) Is PartDocument Then Dim oDoc1 As PartDocument = oDraw1.AllReferencedDocuments.Item(1) Dim sRevNumb As String = oDoc1.PropertySets.Item("Inventor Summary Information").Item("Revision Number").Expression 'Save copy as dxf into dxf folder strFolder = "V:\3D Data\DXF\Design Office dxfs - Steves\" & ThisDoc.FileName(False) 'without extension ThisDoc.Document.SaveAs(strFolder & (" REV ") & sRevNumb & (".dxf"), True) End If 'Activate Sheet 1 before closing ActiveSheet = ThisDrawing.Sheet("Sheet:1") ThisApplication.CommandManager.ControlDefinitions.Item("AppZoomallCmd").Execute '------------------------End of pdf and dxf creation------------------------------------- 'Dim statement: Declares and allocates storage space for variables Dim oPart As Inventor.PartDocument 'Using this active drawing document oDrawingDoc = ThisDrawing.Document 'Using this active sheet oSheet = ActiveSheet.Sheet 'Using the first view in this drawing sheet oDrawingView = oSheet.DrawingViews(1) If ActiveSheet.View(oDrawingView.Name).ModelDocument.DocumentType = Inventor.DocumentTypeEnum.kPartDocumentObject Then 'Using the part in this first view oPart = ActiveSheet.View(oDrawingView.Name).ModelDocument End If 'Assuming part and drawing share the same file name NewFileName = ThisDoc.ChangeExtension(".ipt") 'Open the part seperately ThisApplication.Documents.Open(NewFileName, True) If oPart.DocumentType = kPartDocumentObject Then 'Confirm Part If oPart.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then ' 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 oStepFileName = iProperties.Value("Project", "Part Number") If oSTEPTranslator.HasSaveCopyAsOptions(ThisApplication.ActiveDocument, oContext, oOptions) Then ' Set application protocol. ' 2 = AP 203 - Configuration Controlled Design ' 3 = AP 214 - Automotive Design oOptions.Value("ApplicationProtocolType") = 2 ' Other options... 'oOptions.Value("Author") = "" 'oOptions.Value("Authorization") = "" 'oOptions.Value("Description") = "" 'oOptions.Value("Organization") = "" oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism Dim oData As DataMedium oData = ThisApplication.TransientObjects.CreateDataMedium Dim oDraw2 As DrawingDocument = ThisDoc.Document If TypeOf oDraw2.AllReferencedDocuments.Item(1) Is PartDocument Then Dim oDoc2 As PartDocument = oDraw2.AllReferencedDocuments.Item(1) Dim sRevNumb As String = oDoc2.PropertySets.Item("Inventor Summary Information").Item("Revision Number").Expression strFolder = "V:\3D Data\DXF\Design Office dxfs - Steves\" & ThisDoc.FileName(False) 'without extension oData.FileName = strFolder & "\" & oStepFileName & " REV " & sRevNumb & ".stp" 'oData.FileName = strFolder & oStepFileName & " REV " & sRevNumb & ".stp" 'ThisDoc.Document.SaveAs(strFolder & (" REV ") & sRevNumb & (".stp"), True) End If ' strFolder = "V:\3D Data\DXF\Design Office dxfs - Steves\" ' oData.FileName = strFolder & "\" & oStepFileName & ".stp" oSTEPTranslator.SaveCopyAs(ThisApplication.ActiveDocument, oContext, oOptions, oData) End If Else 'Confirm Standard MessageBox.Show("Not a sheet metal part - No STEP file saved", "Check: Is this sheet metal?") End If End If ThisApplication.CommandManager.ControlDefinitions.Item("AppFileCloseCmd").Execute 'Gives Feedback to User MessageBox.Show("Rule completed", "File Save") End Sub
Solved! Go to Solution.