solidworks子装配体与零件批量重命名

将solidworks装配体里的子装配体命名为ASM001,ASM002,ASM003依次类推,

将零件命名为PART001,PART002,PART003依次类推。

'强制在代码中声明所有变量。这意味着在使用任何变量之前,必须先使用 Dim、Public、Private 等关键字明确地声明该变量。
Option Explicit

'将swApp声明为SldWorks应用程序对象类型
Dim swApp As SldWorks.SldWorks

'将swModel声明为ModelDoc2文档对象类型
Dim swModel As SldWorks.ModelDoc2

'将swAssy声明为AssemblyDoc装配体文档对象类型
Dim swAssy As SldWorks.AssemblyDoc

'将boolstatus声明为布尔类型
Dim boolstatus As Boolean
Dim bool1 As Boolean
Dim bool2 As Boolean

'将partCounter声明为整型
Dim partCounter As Integer

'将asmCounter声明为整型
Dim asmCounter As Integer

'将changesCount声明为整型
Dim changesCount As Integer

'将totalComponentsCount声明为整型
Dim totalComponentsCount As Integer

Dim swErrors As Long
Dim swWarnings As Long

Dim ConfigOption As Integer
Dim ConfigName As String
Dim UpdateStatus As Integer

'将comp声明为Component2组件类型,Optional表示参数可选(即可以不提供这个参数,如果不提供默认双引号内部的参数)
Sub RenameComponents(comp As SldWorks.Component2, Optional parentPath As String = "")

    '当发生错误时,跳转到发生错误的位置
    On Error GoTo ErrorHandler
    
    '将swChildComp声明为Component2组件类型
    Dim swChildComp As SldWorks.Component2
    
    '将vChildComps声明为Variant类型,Variant 是 VBA 中的一种特殊数据类型,可以存储任意类型的数据,包括数字、字符串、对象、数组等。
    Dim vChildComps As Variant
    
    '将I命名为长整型
    Dim I As Long
    
    'totalComponentsCount总组件数
    totalComponentsCount = totalComponentsCount + 1
    
    '将fullPath声明为String类型
    Dim fullPath As String
    
    '如果parentPath为空
    If parentPath = "" Then
    
        'fullPath赋值为comp.Name2,Name2是Component2的一个属性,可以获取或设置所选组件的名称。
        fullPath = comp.Name2
    Else
        'fullPath赋值为路径+comp.Name2。
        fullPath = parentPath & "/" & comp.Name2
    End If
    
    '输出debug信息
    Debug.Print "处理组件: " & fullPath & " (级别: " & comp.GetPathName & ")"
    
    '用GetChildren方法获取获取一个组件的所有子组件
    vChildComps = comp.GetChildren
    
    ' 检查是否有子组件
    If Not IsEmpty(vChildComps) Then
    
        '输出子组件的数量
        Debug.Print "组件 " & fullPath & " 的子组件数量: " & UBound(vChildComps) + 1
        
        ' 遍历所有子组件
        For I = 0 To UBound(vChildComps)
        
            '设置swChildComp为第I个子组件
            Set swChildComp = vChildComps(I)
            
            '如果swChildComp不为空
            If Not swChildComp Is Nothing Then
            
                '如果子组件未被压缩
                If Not swChildComp.IsSuppressed Then
                
                    '将compType声明为长整型
                    Dim compType As Long
                    
                    '将swChildDoc声明为ModelDoc2文档对象类型
                    Dim swChildDoc As SldWorks.ModelDoc2
                    
                    '获取子组件模型文档
                    Set swChildDoc = swChildComp.GetModelDoc2
                    
                    '如果模型文档不为空
                    If Not swChildDoc Is Nothing Then
                    
                        '获取模型文档的类型
                        compType = swChildDoc.GetType

                        
                        '将newName声明为字符串
                        Dim PartNewName As String
                        Dim iPartNewName As String
                        Dim tPartNewName As String
                        Dim AsmNewName As String
                        Dim iAsmNewName As String
                        Dim tAsmNewName As String
                        
                        '如果子组件为零件类型
                        If compType = swDocPART Then
                            '将oldName声明为字符串
                            Dim PartOldName As String
                        
                            '获取子组件的名称
                            PartOldName = swChildDoc.GetTitle
                            
                            If Left(PartOldName, 4) = "PART" Then
                            GoTo NextComponent
                            End If
                           
                           ' 重命名零件
                            boolstatus = swChildDoc.Extension.SelectByID2(PartOldName, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
                            PartNewName = "PART" & Format(partCounter, "000")
                            Debug.Print "尝试重命名 " & PartOldName & " 为 " & PartNewName & ".sldprt"
                            boolstatus = swChildDoc.Extension.RenameDocument(PartNewName)
                            iPartNewName = swChildDoc.GetTitle
                            tPartNewName = Left(iPartNewName, Len(iPartNewName) - 7)
                            ' 强制重建整个零件
                            swChildDoc.ForceRebuild3 True
 
                            ' 刷新设计树
                            swChildDoc.EditRebuild3
                            
                            ' 更新外部引用
                            'swChildDoc.Extension.UpdateExternalFileReferences ConfigOption, ConfigName, UpdateStatus
                            
                            ' 保存
                            bool1 = swChildDoc.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
                                                        
                            If PartNewName = tPartNewName Then
                                Debug.Print "重命名 " & PartOldName & " 为 " & PartNewName & ".sldprt" & "成功"
                                Else
                                Debug.Print "重命名 " & PartOldName & " 为 " & PartNewName & ".sldprt" & "失败"
                            End If
                            
                            partCounter = partCounter + 1
                            
                        '如果子组件为装配体类型
                        ElseIf compType = swDocASSEMBLY Then
                        
                            '将oldName声明为字符串
                            Dim AsmOldName As String
                        
                            '获取子组件的名称
                            AsmOldName = swChildDoc.GetTitle
                            
                            If Left(AsmOldName, 3) = "ASM" Then
                            GoTo NextComponent
                            End If
                            
                            ' 重命名子装配体
                            boolstatus = swChildDoc.Extension.SelectByID2(AsmOldName, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
                            AsmNewName = "ASM" & Format(asmCounter, "000")
                            Debug.Print "尝试重命名 " & AsmOldName & " 为 " & AsmNewName & ".sldasm"
                            boolstatus = swChildDoc.Extension.RenameDocument(AsmNewName)
                            iAsmNewName = swChildDoc.GetTitle
                            tAsmNewName = Left(iAsmNewName, Len(iAsmNewName) - 7)
                            ' 强制重建整个装配体
                            swChildDoc.ForceRebuild3 True
 
                            ' 刷新设计树
                            swChildDoc.EditRebuild3
                            
                            ' 更新外部引用
                            'swChildDoc.Extension.UpdateExternalFileReferences ConfigOption, ConfigName, UpdateStatus
                            
                            ' 保存
                            bool2 = swChildDoc.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
                            
                            If AsmNewName = tAsmNewName Then
                                Debug.Print "重命名 " & AsmOldName & " 为 " & AsmNewName & ".sldasm" & "成功"
                                Else
                                Debug.Print "重命名 " & AsmOldName & " 为 " & AsmNewName & ".sldasm" & "失败"
                            End If
                                                       
                            asmCounter = asmCounter + 1
                        Else
                            'Debug.Print "未知组件类型,跳过: " & AsmOldName
                            
                            '下一个组件
                            GoTo NextComponent
                        End If
                        
                        ' 递归处理子组件
                        RenameComponents swChildComp, fullPath
                    Else
                        Debug.Print "无法获取组件的ModelDoc2: " & swChildComp.Name2
                    End If
                Else
                    Debug.Print "跳过被抑制的组件: " & fullPath & "/" & swChildComp.Name2
                End If
            Else
                Debug.Print "子组件对象为空"
            End If
NextComponent:
        Next I
    Else
        Debug.Print "该组件没有子组件"
    End If
    Exit Sub
    
ErrorHandler:
    Debug.Print "在RenameComponents中发生错误: " & Err.Description & " at line " & Erl
    Resume Next
End Sub
Sub main()
    On Error GoTo ErrorHandler
    
    Debug.Print vbCrLf
    Debug.Print "--------------------------------------------------------------------------------"
    Debug.Print "宏开始运行"
 
    Set swApp = Application.SldWorks
 
    If swApp Is Nothing Then
        MsgBox "无法获取SolidWorks应用程序对象"
        Exit Sub
    End If
 
    Set swModel = swApp.ActiveDoc
 
    If swModel Is Nothing Then
        MsgBox "请打开一个装配体文档"
        Exit Sub
    End If
 
    If swModel.GetType <> swDocASSEMBLY Then
        MsgBox "当前文档不是装配体"
        Exit Sub
    End If
 
    Set swAssy = swModel
 
    partCounter = 1
    asmCounter = 1
    changesCount = 0
    totalComponentsCount = 0
 
    ' 开始重命名过程
    Dim rootComp As SldWorks.Component2
    Set rootComp = swAssy.ConfigurationManager.ActiveConfiguration.GetRootComponent3(True)
 
    If rootComp Is Nothing Then
        MsgBox "无法获取根组件"
        Exit Sub
    End If
 
    Debug.Print "开始遍历组件"
    RenameComponents rootComp
 
    ' 强制重建整个装配体
    swModel.ForceRebuild3 True
 
    ' 刷新设计树
    swModel.EditRebuild3
 
    ' 保存更改
    swModel.Save3 swSaveAsOptions_Silent, 0, 0
 
    Debug.Print "重命名完成。总组件数: " & totalComponentsCount - 1 & ", 更改的零件数量: " & partCounter - 1 & ", 更改的装配体数量:" & asmCounter - 1
    MsgBox "重命名完成。总组件数: " & totalComponentsCount - 1 & ", 更改的零件数量: " & partCounter - 1 & ",更改的装配体数量:" & asmCounter - 1
    Exit Sub
 
ErrorHandler:
    MsgBox "发生错误: " & Err.Description
End Sub

 

 

 

 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值