2
\$\begingroup\$

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. enter image description here

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
\$\endgroup\$
2
  • \$\begingroup\$ Does this code work? Code review is only for working code. \$\endgroup\$
    – HackSlash
    May 18, 2022 at 16:31
  • \$\begingroup\$ Hello HackSlash, Yes, this code is working perfectly. \$\endgroup\$ May 20, 2022 at 6:47

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.