引用于 cad 在 2025年6月14日, 下午8:54

Option Explicit

Sub Main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim dicCount As Object ' 用于存储零部件名称与数量

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set dicCount = CreateObject("Scripting.Dictionary")

' 验证当前文档是否为装配体
If Not swModel.GetType = swDocASSEMBLY Then
MsgBox "请打开装配体文件！"
Exit Sub
End If

Set swAssy = swModel
swAssy.ResolveAllLightWeightComponents True ' 强制还原所有轻化组件

' 递归遍历装配体
TraverseComponents swAssy, swAssy.GetComponents(True), dicCount

' 将统计结果写入自定义属性
WriteCustomProperties swApp, dicCount

MsgBox "统计完成！"
End Sub

Sub TraverseComponents(assy As AssemblyDoc, comps As Variant, dic As Object)
Dim i As Integer
For i = 0 To UBound(comps)
Dim swComp As Component2
Set swComp = comps(i)

' 跳过压缩、封套件
If swComp.IsSuppressed Or swComp.IsEnvelope Then GoTo NextComponent

' 还原轻化组件
If swComp.GetModelDoc2 Is Nothing Then
swComp.SetSuppressionState swComponentSuppressionState_e.swComponentResolved
End If

Dim swChildModel As ModelDoc2
Set swChildModel = swComp.GetModelDoc2

If Not swChildModel Is Nothing Then
Select Case swChildModel.GetType
Case swDocPART
' 统计零件数量
CountComponent dic, swChildModel.GetPathName
Case swDocASSEMBLY
' 统计子装配体数量
CountComponent dic, swChildModel.GetPathName
' 递归遍历子装配体
TraverseComponents assy, swComp.GetChildren, dic
End Select
End If

NextComponent:
Next
End Sub

Sub CountComponent(dic As Object, path As String)
If dic.Exists(path) Then
dic(path) = dic(path) + 1
Else
dic.Add path, 1
End If
End Sub

Sub WriteCustomProperties(swApp As SldWorks.SldWorks, dic As Object)
Dim vKey As Variant
For Each vKey In dic.Keys
Dim swModel As ModelDoc2
Set swModel = swApp.OpenDoc6(vKey, swDocPART, swOpenDocOptions_e.swOpenDoc_Silent, "", 0, 0)

If Not swModel Is Nothing Then
Dim cusPropMgr As CustomPropertyManager
Set cusPropMgr = swModel.Extension.CustomPropertyManager("") ' 自定义属性域

' 添加/更新"数量"属性
If Not cusPropMgr.Add3("数量", swCustomPropertyType_e.swCustomPropertyTypeText, dic(vKey)) Then
cusPropMgr.Set2 "数量", dic(vKey)
End If

swModel.Save ' 保存修改
swApp.CloseDoc vKey
End If
Next
End Sub

这段 SolidWorks VBA 宏代码的主要目的是：统计当前打开的装配体中所有零部件（包括子装配体）的数量，并将结果写入每个零部件文件的自定义属性中。

✅ 一、代码结构分析

✅ 1. 主程序入口：Sub Main()

Sub Main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim dicCount As Object ' 用于存储零部件名称与数量

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set dicCount = CreateObject("Scripting.Dictionary")

' 验证当前文档是否为装配体
If Not swModel.GetType = swDocASSEMBLY Then
MsgBox "请打开装配体文件！"
Exit Sub
End If

Set swAssy = swModel
swAssy.ResolveAllLightWeightComponents True ' 强制还原所有轻化组件

' 递归遍历装配体
TraverseComponents swAssy, swAssy.GetComponents(True), dicCount

' 将统计结果写入自定义属性
WriteCustomProperties swApp, dicCount

MsgBox "统计完成！"
End Sub

🔍 说明：

CreateObject("Scripting.Dictionary")：创建一个字典对象，用于统计零部件的路径和数量。
swModel.GetType = swDocASSEMBLY：判断当前打开的文档是否为装配体。
ResolveAllLightWeightComponents True：将所有轻量化组件还原，确保能正确获取所有零部件。
TraverseComponents：递归遍历装配体中的所有组件，统计其数量。
WriteCustomProperties：将统计结果写入每个零部件的自定义属性中。

✅ 2. 遍历装配体组件：Sub TraverseComponents()

Sub TraverseComponents(assy As AssemblyDoc, comps As Variant, dic As Object)
Dim i As Integer
For i = 0 To UBound(comps)
Dim swComp As Component2
Set swComp = comps(i)

' 跳过压缩、封套件
If swComp.IsSuppressed Or swComp.IsEnvelope Then GoTo NextComponent

' 还原轻化组件
If swComp.GetModelDoc2 Is Nothing Then
swComp.SetSuppressionState swComponentSuppressionState_e.swComponentResolved
End If

Dim swChildModel As ModelDoc2
Set swChildModel = swComp.GetModelDoc2

If Not swChildModel Is Nothing Then
Select Case swChildModel.GetType
Case swDocPART
' 统计零件数量
CountComponent dic, swChildModel.GetPathName
Case swDocASSEMBLY
' 统计子装配体数量
CountComponent dic, swChildModel.GetPathName
' 递归遍历子装配体
TraverseComponents assy, swComp.GetChildren, dic
End Select
End If

NextComponent:
Next
End Sub

🔍 说明：

swComp.IsSuppressed / swComp.IsEnvelope：跳过压缩的组件和封套件。
swComp.SetSuppressionState：如果组件是轻量化组件（GetModelDoc2 Is Nothing），将其还原。
GetChildren：获取组件的子组件，用于递归遍历。
CountComponent：统计零件或子装配体的数量。

✅ 3. 统计功能：Sub CountComponent()

Sub CountComponent(dic As Object, path As String)
If dic.Exists(path) Then
dic(path) = dic(path) + 1
Else
dic.Add path, 1
End If
End Sub

🔍 说明：

dic.Exists(path)：判断路径是否已存在于字典中。
dic.Add(path, 1) / dic(path) = dic(path) + 1：统计每个零部件路径的出现次数。

✅ 4. 写入自定义属性：Sub WriteCustomProperties()

Sub WriteCustomProperties(swApp As SldWorks.SldWorks, dic As Object)
Dim vKey As Variant
For Each vKey In dic.Keys
Dim swModel As ModelDoc2
Set swModel = swApp.OpenDoc6(vKey, swDocPART, swOpenDocOptions_e.swOpenDoc_Silent, "", 0, 0)

If Not swModel Is Nothing Then
Dim cusPropMgr As CustomPropertyManager
Set cusPropMgr = swModel.Extension.CustomPropertyManager("") ' 自定义属性域

' 添加/更新"数量"属性
If Not cusPropMgr.Add3("数量", swCustomPropertyType_e.swCustomPropertyTypeText, dic(vKey)) Then
cusPropMgr.Set2 "数量", dic(vKey)
End If

swModel.Save ' 保存修改
swApp.CloseDoc vKey
End If
Next
End Sub

🔍 说明：

OpenDoc6：打开文件（零件文件），静默打开。
CustomPropertyManager：操作自定义属性。
Add3 / Set2：添加或更新自定义属性 "数量"。
Save / CloseDoc：保存并关闭打开的文件。

✅ 二、功能概述

📌 功能总结：

打开装配体：确认当前文档是否为装配体。
还原轻量化组件：确保所有组件可访问。
遍历所有组件：包括零件和子装配体。
统计数量：记录每个零部件路径的出现次数。
写入自定义属性：为每个零部件文件添加或更新自定义属性 "数量"。

✅ 三、代码优点

逻辑清晰：使用 TraverseComponents 实现递归，结构清晰。
兼容性强：可以处理装配体、子装配体、零件。
可读性高：使用 Dictionary 对象进行统计，便于理解和维护。

✅ 四、可能的优化与改进建议

✅ 1. 性能优化建议：

避免重复打开文件：当前代码对每个文件都重新打开，效率较低。建议：
只打开一次文件，使用 swModel.Extension.CustomPropertyManager("") 操作属性。
使用 IsFileOpen 判断文件是否已打开，避免重复打开。

✅ 2. 错误处理增强：

添加错误处理逻辑，如：

On Error Resume Next
...
On Error GoTo 0

✅ 3. 支持多语言：

自定义属性名 "数量" 是中文，可能在某些系统中不兼容，建议改为英文 "Quantity"。

✅ 4. 扩展为多线程处理：

如果装配体中零部件非常多，可以考虑使用 多线程 来提高处理速度（VBA不支持多线程，但可以考虑使用外部脚本或插件）。

✅ 五、代码示例（优化建议）

Sub WriteCustomProperties_Optimized(swApp As SldWorks.SldWorks, dic As Object)
Dim vKey As Variant
For Each vKey In dic.Keys
Dim swModel As ModelDoc2
Set swModel = swApp.OpenDoc6(vKey, swDocPART, swOpenDocOptions_e.swOpenDoc_Silent, "", 0, 0)

If Not swModel Is Nothing Then
Dim cusPropMgr As CustomPropertyManager
Set cusPropMgr = swModel.Extension.CustomPropertyManager("")

' 添加/更新"数量"属性
If Not cusPropMgr.Add3("数量", swCustomPropertyType_e.swCustomPropertyTypeText, dic(vKey)) Then
cusPropMgr.Set2 "数量", dic(vKey)
End If

swModel.Save
swApp.CloseDoc vKey
End If
Next
End Sub

✅ 六、总结

这段 VBA 宏代码是一个非常实用的装配体统计工具，适用于自动化装配体零部件统计和数据管理。它结构清晰，逻辑完整，适合用于工程和制造流程中，提升数据管理效率。

如需我帮你扩展为多线程统计、添加更多统计维度（如：重量、材料等）、导出为 Excel 或 CSV，也可以继续问我！