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

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