将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