Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Macro not running

koubaleite

Mechanical
Nov 27, 2024
22
Hello, this is my first time encountering this. I have double checked and all my variables just work fine and have the right values.

I did recently an update of SolidWorks and from what I read online I have to update references (already did).

Does anyone able to run this code on their computer ?

Do you know why it is not running on mine ?

Thanks in advance
Code:
Sub TraverseAndRenameComponents(swModel As SldWorks.ModelDoc2, Codice As String, ByRef Position As Long)
    Dim swConfMgr As SldWorks.ConfigurationManager
    Dim swConf As SldWorks.Configuration
    Dim swRootComp As SldWorks.Component2
    Dim vChildComp As Variant
    Dim i As Long
    Dim swChildComp As SldWorks.Component2
    Dim swChildModel As SldWorks.ModelDoc2

    ' Get Configuration Manager and Active Configuration
    Set swConfMgr = swModel.ConfigurationManager
    Set swConf = swConfMgr.ActiveConfiguration
    Set swRootComp = swConf.GetRootComponent3(True)

    ' Check if the root component is valid
    If swRootComp Is Nothing Then
        MsgBox "No components found in the assembly."
        Exit Sub
    End If

    ' Traverse child components
    vChildComp = swRootComp.GetChildren

    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        If Not swChildComp Is Nothing Then
            Set swChildModel = swChildComp.GetModelDoc2
            
            If Not swChildModel Is Nothing Then
                If swChildModel.GetType = swDocASSEMBLY Then
                    ' Recursively traverse subassemblies
                    TraverseAndRenameComponents swChildModel, Codice, Position
                ElseIf swChildModel.GetType = swDocPART Then
                    Dim OldName As String
                    Dim NewName As String

                    ' Use component name as description for naming
                    OldName = swChildComp.Name2
                    NewName = Codice & "_" & Position & "_" & OldName

                    ' Rename component and increment position
                    Debug.Print "Old name: " & OldName
                    Debug.Print "New name: " & NewName
                    swChildComp.Name2 = NewName
                    Position = Position + 1
                End If
            End If
        End If
    Next i
End Sub

Sub Main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim Codice As String
    Dim Position As Long

    ' Create the SolidWorks application object
    Set swApp = Application.SldWorks

    ' Set the active document
    Set swModel = swApp.ActiveDoc

    ' Check if there's an active document
    If swModel Is Nothing Then
        MsgBox "No active document found."
        Exit Sub
    End If

    ' Ensure the active document is an assembly
    If swModel.GetType <> swDocASSEMBLY Then
        MsgBox "The active document is not an assembly."
        Exit Sub
    End If

    ' Get user input for Codice (fixed prefix) and Position (starting number)
    Codice = InputBox("Enter Codice (fixed prefix):")
    Position = CLng(InputBox("Enter starting Position number:"))

    ' Traverse and rename components
    TraverseAndRenameComponents swModel, Codice, Position
End Sub
 
Replies continue below

Recommended for you

Part and Inventory Search

Sponsor