Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
MechMachineMan
in reply to: ralfmja

 

'Code adapted from Owner2229.

Sub Test()
'ThisApplication.SilentOperation = True
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument oPrefix = InputBox("Enter new prefix", "Helper", "XXX")
oInt = 1
oNewName = GetNewName(oDoc.FullFileName)
Call UpdatePartNumber(oDoc, oNewName)
Call oDoc.SaveAs(oNewName, False) Call RenameChildFiles(oDoc) Call oDoc.Save
'ThisApplication.SilentOperation = False
End Sub Dim oInt As Integer
Dim oPrefix As String
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 = oInt.ToString("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
Dim iPro 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}")
iProperty = oPropSet.Item(oProp)
IPCatch:
Call oPropSet.Add("", oProp)
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