1 Reply Latest reply on Aug 21, 2016 8:18 AM by Deepak Gupta

    Stocksize MACRO

    Antonio Cavka

      Hi,

      I have a macro that can capture all bounding box dimensions and displays them in ascending order in custom properties. I started to use TASK and now i can run a macro on many parts without to manual open them and run macro.

      Problem is that i work with sheet metal parts and that macro does not flatten sheet metal parts before it takes dimensions.

      Does someone know how to modify that macro to check a part configuration and if it if a sheet metal first to flatten it and then to take dimensions.

      MACRO:

       

      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

       

       

      Dim swCustPropMgr As SldWorks.CustomPropertyManager

      Dim swModel As SldWorks.ModelDoc2

      Dim StockSize As String

      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

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

         Dimenzije = (arr(1) & "x" & arr(2) & "x" & arr(3))

        

       

       

      Set swCustProp = Part.Extension.CustomPropertyManager("")

      retval = Part.DeleteCustomInfo2("", "Dimenzije") 'Remove existing properties

      swCustProp.Add3 "Dimenzije", swCustomInfoText, Dimenzije, 1 'Add latest values

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

      End Sub

      Sub Main()

      Dim arr(1 To 3) As Double

       

       

      Set swApp = Application.SldWorks

      Set Part = swApp.ActiveDoc

       

      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

       

       

      End Sub

       

       

      Nice day

      Antonio