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
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