I want to apply a tolerance value to my sketch using a custom property, the input for which will be provided as JSON
Here I tried to collect the sketch name from the specific feature (i.e ISO Standard Feature) from the Solidworks feature tree.
Once the feature is available, GetDispDimension
collects all the names available in the sketch and stores them in an array.
Sub GetDispDimension()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swPart = swModel
'Hunt for sketch name in the feature tree
SKETCH_NAME = "ISO Standard"
Set swFeat = swPart.FeatureByName(SKETCH_NAME)
Set swDispDim = swFeat.GetFirstDisplayDimension
i = 0
Do While Not swDispDim Is Nothing
Set swDim = swDispDim.GetDimension2(1)
vDimVals = swDim.GetValue3(swThisConfiguration, Empty)
'Debug.Print swDim.Name & "@" & SKETCH_NAME & ": " & Round(vDimVals(0), 6)
Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
swDimName = swDim.Name
swDimNameArr(i) = UCase(swDimName)
'Debug.Print swDim.Name & "**** Debug"'
Debug.Print " Dimension Name : " & i & " : " & swDimNameArr(i)
'if sketch name have TOL_Min then hunt for matching custom property
If InStr(1, swDimNameArr(i), "TOL_MIN", vbTextCompare) Then
Call GetCustomProperty
Else
Debug.Print "NOT FOUND"
End If
i = i + 1
Loop
End Sub
GetCustomProperty
applies tolerance, either open or bilaterial, based on the TOL_MIN
and TOL_MAX
dimensions
Sub GetCustomProperty()
Dim j As Integer
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swPart = swModel
Set swSelMgr = swModel.SelectionManager
Set swDimension = swDispDim.GetDimension2(0)
Set swDimensionTolerance = swDimension.Tolerance
swCustInfoNameArr = swModel.GetCustomInfoNames2("")
'For Each Custom property Name In swDimNameArr
j = 0
swCustInfoNameArr = swCustInfoNameArr(j) 'UCase(CustName)
Do While j < UBound(swCustInfoNameArr)
Debug.Print "Custom Property Name : "; j & " : " & UCase(swCustInfoNameArr(j))
If InStr(1, swCustInfoNameArr(j), "TOL_MIN", vbTextCompare) Then
Debug.Print swDimNameArr(i)
' Get the custom property data
maxValue = swCustProp.Get4(CustName, False, val, valout)
MaxTolValue = valout
'convertion to metric unit
MaxTolValueMetric = MaxTolValue / 1000
Debug.Print "Maximum Tolerance value: " & MaxTolValue
MsgBox MaxTolValue
'Set tolerance type to fit with tolerance and transitional
swDimensionTolerance.Type = swTolType_e.swTolBILAT
Debug.Print "Type of tolerance (8 = swTolType_e.swTolBILAT): " & swDimensionTolerance.Type
swDimensionTolerance.FitType = swFitType_e.swFitTRANSITIONAL
Debug.Print "Type of fit tolerance (2 = swFitType_e.swFitTransitional): " & swDimensionTolerance.FitType
Debug.Print ""
Else
Debug.Print "NOT MATCHED"
End If
j = j + 1
Loop
'Exit For
For Each CustName In swCustInfoNameArr
CustName = UCase(CustName)
Debug.Print "Custom Property Name : " & CustName
' Get the custom property data
Set swCustProp = swModelDocExt.CustomPropertyManager("")
minValue = swCustProp.Get4(CustName, False, val, valout)
MinTolValue = valout
'Selected dimension name containing Max_TOL
If InStr(1, CustName, "TOL_MAX", vbTextCompare) Then
'convertion to metric unit
MaxTolValueMetric = MaxTolValue / 1000
Debug.Print "Maximum Tolerance value: " & MaxTolValue
MsgBox MaxTolValue
'Debug.Print "Value: " & val
Debug.Print "Evaluated value: " & valout
ElseIf InStr(1, CustName, "TOL_MIN", vbTextCompare) Then
'convertion to metric unit
MinTolValueMetric = MinTolValue / 1000
Debug.Print "Minimum Tolerance value: " & MinTolValue
MsgBox MinTolValue
'Debug.Print "Value: " & val
Debug.Print "Evaluated value: " & valout
If MaxTolValue = MinTolValue Then
' Select the Symmetric tolerance
'Set tolerance type to fit with tolerance
swDimensionTolerance.Type = swTolType_e.swTolSYMMETRIC
Debug.Print "Type of tolerance (8 = swTolType_e.swTolSYMMETRIC): " & swDimensionTolerance.Type
swDimensionTolerance.FitType = swFitType_e.swFitTRANSITIONAL
Debug.Print "Type of fit tolerance (2 = swFitType_e.swFitTransitional): " & swDimensionTolerance.FitType
Debug.Print ""
Else
' Select the Bilateral tolerance
'Set tolerance type to fit with tolerance and transitional
swDimensionTolerance.Type = swTolType_e.swTolBILAT
Debug.Print "Type of tolerance (8 = swTolType_e.swTolBILAT): " & swDimensionTolerance.Type
swDimensionTolerance.FitType = swFitType_e.swFitTRANSITIONAL
Debug.Print "Type of fit tolerance (2 = swFitType_e.swFitTransitional): " & swDimensionTolerance.FitType
Debug.Print ""
End If
' Set new dimension tolerance values
Status = swDimensionTolerance.SetValues2(MinTolValueMetric, MaxTolValueMetric, swSetValueInConfiguration_e.swSetValue_InThisConfiguration, swTolType_e.swTolBILAT)
Debug.Print (" Maximum dimension tolerance: " & swDimensionTolerance.SetValues(MinTolValueMetric, MaxTolValueMetric))
'Debug.Print (" Minimum dimension tolerance: " & swDimensionTolerance.SetValues(MinTolValue / 1000, 0))
'Get some dimension tolerance values
fontHeight = swDimensionTolerance.GetFontHeight
Debug.Print (" Height of font: " & fontHeight * 1000# & " mm")
fontScale = swDimensionTolerance.GetFontScale
Debug.Print (" Scale of font: " & fontScale)
Debug.Print ""
Else
Debug.Print (" Tolerance cannot be applied to this dimension ")
End If
'Else
' Debug.Print ("Dimension name and custom property didnt match")
'End If
Next
End Sub