Автоматическое назначение набора единиц SolidWorks ⇐ JAVA

[Anonymous]

Друзья, у меня есть код, который MMGS объединяет все компоненты сборки SolidWorks в VBA, но я получаю сообщение об ошибке в строке, отмеченной желтым цветом. Может кто-нибудь сказать мне, почему? Спасибо.
введите здесь описание изображения

Код: Выделить всё

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

У меня есть код, который объединяет все компоненты сборки в SolidWorks в MMGS, но я получаю сообщение об ошибке в строке, отмеченной желтым цветом


Подробнее здесь: https://stackoverflow.com/questions/787 ... assignment