AnsweredAssumed Answered

Add custom property - Stocksize, Sort Dimensions macro

Question asked by JOHN GEORGE on Jul 20, 2016
Latest reply on Jul 21, 2016 by Elmar Klammer

I tried to modify one of the bounding box macro from this forum and added few lines to sort the values in order (posted in another discussion)

I have couple of issues with the result

  • It returns the message box result correct, but custom property values are different (shows only 0 x 0 x 0)
  • When I change my part units to fractions, it shows error in line "arr(1) = Length"

Here is the full code

Can someone please help me to solve the issue?

Thanks!

 

 

Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim Height As Variant
Dim Width As Variant
Dim Length As Variant
Dim Corners As Variant
Dim retval As Boolean
Dim UserUnits As Variant
Const swDocPart = 1
Const swDocASSEMBLY = 2

'Enum swLengthUnit_e
Const swMM = 0
Const swCM = 1
Const swMETER = 2
Const swINCHES = 3
Const swFEET = 4
Const swFEETINCHES = 5
Const swANGSTROM = 6
Const swNANOMETER = 7
Const swMICRON = 8
Const swMIL = 9
Const swUIN = 10

'Enum swFractionDisplay_e
Const swNONE = 0
Const swDECIMAL = 1
Const swFRACTION = 2

Function DecimalToFeetInches(DecimalLength As Variant, Denominator As Integer) As String
  ' converts decimal inches to feet/inches/fractions
  Dim intFeet As Integer
  Dim intInches As Integer
  Dim intFractions As Integer
  Dim FractToDecimal As Double
  Dim remainder As Double
  Dim tmpVal As Double
  
  ' compute whole feet
  intFeet = Int(DecimalLength / 12)
  remainder = DecimalLength - (intFeet * 12)
  tmpVal = CDbl(Denominator)
 
  intInches = Int(remainder)
  remainder = remainder - intInches
 
  If Not (remainder = 0) Then
    If Not (Denominator = 0) Then
      FractToDecimal = 1 / tmpVal
        If FractToDecimal > 0 Then
          intFractions = Int(remainder / FractToDecimal)
          If (remainder / FractToDecimal) - intFractions > 0 Then
            intFractions = intFractions + 1
          End If
        End If
     End If
  End If
  Call FractUp(intFeet, intInches, intFractions, Denominator) ' Simplify up & down
 
  DecimalToFeetInches = LTrim$(Str$(intFeet)) & "'-"
  DecimalToFeetInches = DecimalToFeetInches & LTrim$(Str$(intInches))
  If intFractions > 0 Then
    DecimalToFeetInches = DecimalToFeetInches & " "
    DecimalToFeetInches = DecimalToFeetInches & LTrim$(Str$(intFractions))
    DecimalToFeetInches = DecimalToFeetInches & "/" & LTrim$(Str$(Denominator))
  End If
   
  DecimalToFeetInches = DecimalToFeetInches & Chr$(34)
    
End Function

Function FractUp(InputFt As Integer, InputInch As Integer, InputNum As Integer, InputDenom As Integer)

  While InputNum Mod 2 = 0 And InputDenom Mod 2 = 0
    InputNum = InputNum / 2
    InputDenom = InputDenom / 2
  Wend
 
  If InputDenom = 1 Then  ' Full inch
    InputInch = InputInch + 1
    InputNum = 0
    If InputInch = 12 Then  ' Full foot
      InputFt = InputFt + 1
      InputInch = 0
    End If
  End If       
End Function

'---------------------------------------------------------------------------------

Sub SortDimensions()
    Dim arr(1 To 3) As Double
    arr(1) = Length
    arr(2) = Width
    arr(3) = Height
    SortArr arr
End Sub

 

Sub SortArr(arr() As Double)

    Dim i As Long
    Dim j As Long
    Dim tmp As String
    Dim p As String
   
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(i) > arr(j) Then
                tmp = arr(i)
                arr(i) = arr(j)
                arr(j) = tmp
            End If
        Next j
    Next i

    '---------------------------------------------------------------------------------
   MsgBox (arr(1) & " x " & arr(2) & " x " & arr(3))
   '---------------------------------------------------------------------------------

End Sub

Sub Main()

Dim arr(1 To 3) As Double
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim swModel As SldWorks.ModelDoc2
Dim StockSize As String

Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc
Set swModel = swApp.ActiveDoc
Set swCustProp = swModel.Extension.CustomPropertyManager("")

 

If Part Is Nothing Then     ' Did we get anything?
  MsgBox "You need to have a part or assy open at this point." & Chr$(13) & Chr$(10) _
          & Chr$(10) & "Open one and try again."
  Exit Sub
End If

If (Part.GetType = swDocPart) Then
  Corners = Part.GetPartBox(True)         ' True comes back as system units - meters
ElseIf Part.GetType = swDocASSEMBLY Then  ' Units will come back as meters
  Corners = Part.GetBox(0)
Else
  MsgBox "This macro is only useful with a part or assy." & Chr$(13) & Chr$(10) & "Open one of those and try again."
  Exit Sub
End If

UserUnits = Part.GetUnits()
Select Case Part.GetUnits(0)
  Case swMM
    ConvFactor = 1 * 1000
  Case swCM
    ConvFactor = 1 * 100
  Case swMETER
    ConvFactor = 1
  Case swINCHES
    ConvFactor = 1 / 0.0254
  Case swFEET
    ConvFactor = 1 / (0.0254 * 12)
  Case swFEETINCHES
    ConvFactor = 1 / 0.0254  ' Pass inches through
  Case swANGSTROM
    ConvFactor = 10000000000#
  Case swNANOMETER
    ConvFactor = 1000000000
  Case swMICRON
    ConvFactor = 1000000
  Case swMIL
    ConvFactor = (1 / 0.0254) * 1000
  Case swUIN
    ConvFactor = (1 / 0.0254) * 1000000
End Select

Height = Round((Abs(Corners(4) - Corners(1)) * ConvFactor), UserUnits(3)) ' Z axis
Width = Round((Abs(Corners(5) - Corners(2)) * ConvFactor), UserUnits(3))  ' Y axis
Length = Round((Abs(Corners(3) - Corners(0)) * ConvFactor), UserUnits(3)) ' X axis

' Check for either (Feet-Inches OR Inches) AND fractions.  If so, return Ft-In
If (UserUnits(0) = 5 Or UserUnits(0) = 3) And UserUnits(1) = 2 Then
  Height = DecimalToFeetInches(Height, Val(UserUnits(2)))
  Width = DecimalToFeetInches(Width, Val(UserUnits(2)))
  Length = DecimalToFeetInches(Length, Val(UserUnits(2)))
End If

Call SortDimensions

StockSize = (arr(1) & " x " & arr(2) & " x " & arr(3))   
  retval = Part.DeleteCustomInfo2("", "StockSize") 'Remove existing properties 
  swCustProp.Add3 "Stocksize", swCustomInfoText, StockSize, 1 'Add latest values
End Sub

Outcomes