03-22-2018
12:00 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
03-22-2018
12:00 PM
I think this version should function better...
Dim oInt As Integer
Dim oPrefix As String
Sub Test()
'ThisApplication.SilentOperation = True
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
oPrefix = InputBox("Enter new prefix", "Helper", "XXX")
oInt = 1
Dim oNewName As String
oNewName = GetNewName(oDoc.FullFileName)
Call UpdatePartNumber(oDoc, oNewName)
Call oDoc.SaveAs(oNewName, False)
Call RenameChildFiles(oDoc)
Call oDoc.Save
'ThisApplication.SilentOperation = False
End Sub
Public Sub RenameChildFiles(oDoc As Inventor.Document)
Dim oRefFile As FileDescriptor
For Each oRefFile In oDoc.File.ReferencedFileDescriptors
Dim oName As String
oName = oRefFile.FullFileName
Dim aDoc As Inventor.Document
Set aDoc = ThisApplication.Documents.Open(oName, False)
If aDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Call RenameChildFiles(aDoc)
End If
Dim oNewName As String
oNewName = GetNewName(oName)
Call UpdatePartNumber(aDoc, oNewName)
Call aDoc.SaveAs(oNewName, False)
Call aDoc.Close(True)
Call oRefFile.ReplaceReference(oNewName)
Next
End Sub
Public Function GetNewName(oName As String) As String
Dim FNP As Integer
FNP = InStrRev(oName, "\", -1)
Dim oPath As String
oPath = Left(oName, FNP)
oExt = Right(oName, 4)
Dim oNumber As String
oNumber = Format(oInt, "0000")
Dim oNewName As String
GetNewName = oPath & oPref & "-" & oNumber & oExt
End Function
Public Sub UpdatePartNumber(oDoc As Inventor.Document, PN As String)
Dim FNP As Integer
FNP = InStrRev(PN, "\", -1)
PN = Mid(PN, FNP + 1)
PN = Left(PN, Len(PN) - 4)
iProperty(oDoc, "Part Number").Expression = PN
End Sub
Public Function iProperty(oDoc As Inventor.Document, oProp As String) As Inventor.Property
On Error GoTo IPCatch
Dim oPropsets As PropertySets
Set oPropsets = oDoc.PropertySets
Dim oPropSet As PropertySet
Set oPropSet = oPropsets.Item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}")
Set iProperty = oPropSet.Item(oProp)
Exit Function
IPCatch:
Call oPropSet.Add("", oProp)
Set iProperty = oPropSet.Item(oProp)
End Function
--------------------------------------
Did you find this reply helpful ? If so please use the 'Accept as Solution' or 'Like' button below.
Justin K
Inventor 2018.2.3, Build 227 | Excel 2013+ VBA
ERP/CAD Communication | Custom Scripting
Machine Design | Process Optimization

iLogic/Inventor API: Autodesk Online Help | API Shortcut In Google Chrome | iLogic API Documentation
Vb.Net/VBA Programming: MSDN | Stackoverflow | Excel Object Model
Inventor API/VBA/Vb.Net Learning Resources: Forum Thread
Sample Solutions:Debugging in iLogic ( and Batch PDF Export Sample ) | API HasSaveCopyAs Issues |
BOM Export & Column Reorder | Reorient Skewed Part | Add Internal Profile Dogbones |
Run iLogic From VBA | Batch File Renaming| Continuous Pick/Rename Objects
Local Help: %PUBLIC%\Documents\Autodesk\Inventor 2018\Local Help
Ideas: Dockable/Customizable Property Browser | Section Line API/Thread Feature in Assembly/PartsList API Static Cells | Fourth BOM Type
Inventor 2018.2.3, Build 227 | Excel 2013+ VBA
ERP/CAD Communication | Custom Scripting
Machine Design | Process Optimization
iLogic/Inventor API: Autodesk Online Help | API Shortcut In Google Chrome | iLogic API Documentation
Vb.Net/VBA Programming: MSDN | Stackoverflow | Excel Object Model
Inventor API/VBA/Vb.Net Learning Resources: Forum Thread
Sample Solutions:Debugging in iLogic ( and Batch PDF Export Sample ) | API HasSaveCopyAs Issues |
BOM Export & Column Reorder | Reorient Skewed Part | Add Internal Profile Dogbones |
Run iLogic From VBA | Batch File Renaming| Continuous Pick/Rename Objects
Local Help: %PUBLIC%\Documents\Autodesk\Inventor 2018\Local Help
Ideas: Dockable/Customizable Property Browser | Section Line API/Thread Feature in Assembly/PartsList API Static Cells | Fourth BOM Type