SolidWorks VBA批量设置装配体组件MMGS单位报错求助

我编写了一段SolidWorks VBA代码，用于将装配体的所有组件单位设置为MMGS，但代码中设置单位的几行（标注注释的Linear/Mass/Time/Angle Units相关行）出现报错，恳请帮忙排查原因。

代码如下： #

Dim swApp As Object
Dim swModel As Object
Dim swAssy As Object
Dim swComp As Object
Dim swPart As Object
Dim swConf As Object
Dim swConfMgr As Object

Const swMM = 2
Const swGram = 2
Const swSecond = 0
Const swDegrees = 0

Sub Main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then
        MsgBox "Lütfen bir montaj dosyası açın.", vbExclamation
        Exit Sub
    End If
    
    If swModel.GetType <> 2 Then ' 2 represents an Assembly document
        MsgBox "Lütfen bir montaj dosyası açın.", vbExclamation
        Exit Sub
    End If
    
    Set swAssy = swModel
    Set swConfMgr = swAssy.ConfigurationManager
    Set swConf = swConfMgr.ActiveConfiguration
    
    Dim vComponents As Variant
    vComponents = swConf.GetComponents(False)
    
    For i = 0 To UBound(vComponents)
        Set swComp = vComponents(i)
        Set swPart = swComp.GetModelDoc2
        If Not swPart Is Nothing Then
            ' Linear Units
            swPart.SetUserPreferenceDoubleValue 1, swMM
            ' Mass Units
            swPart.SetUserPreferenceDoubleValue 2, swGram
            ' Time Units
            swPart.SetUserPreferenceDoubleValue 3, swSecond
            ' Angle Units
            swPart.SetUserPreferenceDoubleValue 4, swDegrees
            swPart.EditRebuild3
        End If
    Next i
    
    MsgBox "Tüm bileşenlerin birimleri MMGS olarak ayarlandı."
End Sub

报错原因排查及解决方案： #

• API方法使用错误：SetUserPreferenceDoubleValue用于设置数值型用户偏好，而单位类型属于整数枚举，应使用SetUserPreferenceIntegerValue方法。
• 硬编码数值易出错：直接用1、2、3、4作为参数可读性差，建议替换为SolidWorks内置枚举对应的常量值（或在引用SolidWorks类型库后直接使用枚举名称）。
• 组件可能处于只读状态：部分外部引用组件可能是只读文件，需先解除锁定才能修改。

修改后的代码示例： #

Dim swApp As Object
Dim swModel As Object
Dim swAssy As Object
Dim swComp As Object
Dim swPart As Object
Dim swConf As Object
Dim swConfMgr As Object

' 使用SolidWorks内置枚举对应的常量值
Const swUnitsLinear = 0 ' 对应swUserPreferenceIntegerValue_e.swUnitsLinear
Const swUnitsMass = 1 ' 对应swUserPreferenceIntegerValue_e.swUnitsMass
Const swUnitsTime = 2 ' 对应swUserPreferenceIntegerValue_e.swUnitsTime
Const swUnitsAngle = 3 ' 对应swUserPreferenceIntegerValue_e.swUnitsAngle

Const swMM = 2 ' 对应swLengthUnit_e.swMM
Const swGram = 2 ' 对应swMassUnit_e.swGram
Const swSecond = 0 ' 对应swTimeUnit_e.swSecond
Const swDegrees = 0 ' 对应swAngleUnit_e.swDegrees

Sub Main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then
        MsgBox "请打开一个装配体文件。", vbExclamation
        Exit Sub
    End If
    
    If swModel.GetType <> 2 Then ' 2代表装配体文档
        MsgBox "请打开一个装配体文件。", vbExclamation
        Exit Sub
    End If
    
    Set swAssy = swModel
    Set swConfMgr = swAssy.ConfigurationManager
    Set swConf = swConfMgr.ActiveConfiguration
    
    Dim vComponents As Variant
    vComponents = swConf.GetComponents(False)
    
    For i = 0 To UBound(vComponents)
        Set swComp = vComponents(i)
        Set swPart = swComp.GetModelDoc2
        If Not swPart Is Nothing Then
            ' 解除组件只读锁定
            swPart.LockViewOnly False
            
            ' 使用正确的API设置单位
            swPart.SetUserPreferenceIntegerValue swUnitsLinear, swMM
            swPart.SetUserPreferenceIntegerValue swUnitsMass, swGram
            swPart.SetUserPreferenceIntegerValue swUnitsTime, swSecond
            swPart.SetUserPreferenceIntegerValue swUnitsAngle, swDegrees
            
            swPart.EditRebuild3
            swPart.Save ' 保存修改
        End If
    Next i
    
    MsgBox "所有组件的单位已设置为MMGS。"
End Sub

提示：若VBA项目已引用SolidWorks类型库，可直接使用完整枚举名称（如swUserPreferenceIntegerValue_e.swUnitsLinear），无需硬编码常量值，代码会更健壮。

内容的提问来源于stack exchange，提问作者Onur Özcan