Hey, is this still in 2018? Basically DimensionTolerance::SetValues2 completely doesn't work unless more than one configuration exists.
I sent a bug report to our VAR, but it involved doing some actual work to demonstrate. I've whittled away all the work here so that all you have to do is create a file, select a dimension, and run the macro. The immediate window contains all the output.
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swDispDim As SldWorks.DisplayDimension
Dim swDim As SldWorks.Dimension
Dim swTol As SldWorks.DimensionTolerance
Dim bResult As Boolean
Dim AnySuccess As Boolean
Dim i As Long
Dim TargetMax As Double
Dim TargetMin As Double
Dim MaxVal As Double
Dim MinVal As Double
Dim CfgNames As Variant
Dim OrigName As String
Sub main()
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set swSelMgr = swDoc.SelectionManager
If swSelMgr.GetSelectedObjectType3(1, -1) <> swSelDIMENSIONS Then
MsgBox "To demonstrate this API bug, please select a dimension and run the macro."
Exit Sub
End If
If swDoc.GetConfigurationCount > 1 Then
MsgBox "Please start this demonstration in a document with only one configuration."
Exit Sub
End If
TargetMax = 0.0001
TargetMin = 0.0001
Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)
Debug.Print "Selected DisplayDimension: ", swDispDim.GetNameForSelection
Set swDim = swDispDim.GetDimension2(0) 'Index is supposedly ignored
Debug.Print "Underlying Dimension: ", swDim.Name
Set swTol = swDim.Tolerance
swTol.Type = swTolBILAT
Debug.Print "Number of configurations in this document: ", swDoc.GetConfigurationCount
OrigName = swDoc.GetActiveConfiguration.Name
CfgNames = Array(OrigName)
AnySuccess = False
For i = 0 To 3
bResult = swTol.SetValues2(TargetMin, TargetMax, i, CfgNames)
Debug.Print "swSetValueInConfiguration_e value: " & i, "Success? " & bResult
If bResult Then
AnySuccess = True
End If
Next i
If AnySuccess Then
Debug.Print "Hey, SolidWorks thinks it was successful! But was it really?"
End If
swTol.GetMaxValue2 MaxVal
swTol.GetMinValue2 MinVal
Debug.Print "Target max value: " & TargetMax, "Actual max value: " & MaxVal
Debug.Print "Target min value: " & TargetMin, "Actual min value: " & MinVal
Debug.Print vbCrLf & "Now let's try the obsolete API."
bResult = swTol.SetValues(TargetMin, TargetMax)
If bResult Then
Debug.Print "Hey, SolidWorks thinks it was successful! But was it really?"
End If
swTol.GetMaxValue2 MaxVal
swTol.GetMinValue2 MinVal
Debug.Print "Target max value: " & TargetMax, "Actual max value: " & MaxVal
Debug.Print "Target min value: " & TargetMin, "Actual min value: " & MinVal
Debug.Print vbCrLf & "OK, now let's add a configuration and try again."
TargetMax = 0.0002
TargetMin = 0.0002
swDoc.AddConfiguration3 "Any_Name", "Any Comment", "Any alt name", 0
swDoc.ShowConfiguration2 OrigName 'reactivate original configuration
AnySuccess = False
For i = 0 To 3
bResult = swTol.SetValues2(TargetMin, TargetMax, i, CfgNames)
Debug.Print "swSetValueInConfiguration_e value: " & i, "Success? " & bResult
If bResult Then
AnySuccess = True
End If
Next i
If AnySuccess Then
Debug.Print "Hey, SolidWorks thinks it was successful! But was it really?"
End If
swTol.GetMaxValue2 MaxVal
swTol.GetMinValue2 MinVal
Debug.Print "Target max value: " & TargetMax, "Actual max value: " & MaxVal
Debug.Print "Target min value: " & TargetMin, "Actual min value: " & MinVal
Debug.Print vbCrLf & "This seems to work when multiple configs exist. Let's delete that new config and try again!"
swDoc.DeleteConfiguration2 "Any_Name"
TargetMax = 0.0003
TargetMin = 0.0003
AnySuccess = False
For i = 0 To 3
bResult = swTol.SetValues2(TargetMin, TargetMax, i, CfgNames)
Debug.Print "swSetValueInConfiguration_e value: " & i, "Success? " & bResult
If bResult Then
AnySuccess = True
End If
Next i
If AnySuccess Then
Debug.Print "Hey, SolidWorks thinks it was successful! But was it really?"
End If
swTol.GetMaxValue2 MaxVal
swTol.GetMinValue2 MinVal
Debug.Print "Target max value: " & TargetMax, "Actual max value: " & MaxVal
Debug.Print "Target min value: " & TargetMin, "Actual min value: " & MinVal
Debug.Print "Didn't work for me!!"
End Sub