7 Replies Latest reply on Jul 21, 2016 2:36 AM by Antonio Cavka

    Macro modify

    Antonio Cavka

      Hi all,

      I have a macro that displays all dimensions from part in custom properties...

      How can i modify that macro to display the biggest dimension  first and smallest at last?

      Here is macro:

       

      ' **********************************************************************

      ' * This macro gets the bounding box dimensions for the custom specific

      ' * It checks to make sure you have a proper document open.

      ' * It checks & utilizes the user units.

      ' *

      ' * Modified by Wayne Tiffany, Oct 12, 2004

      ' * Updated 10/15/04

      ' *

      ' * Original few lines of demo code by someone else (unknown).  Fraction

      ' * converter original code from rocheey.  3D sketch original code from

      ' * SW help.

      ' * Modified on July 11, 2016

      ' **********************************************************************

       

       

      Dim swApp As SldWorks.SldWorks

      Dim Part As SldWorks.ModelDoc2

      Dim Height As Variant

      Dim Length As Variant

      Dim Width 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 Main()

       

       

      Set swApp = CreateObject("SldWorks.Application")

      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

       

       

      Width = Round((Abs(Corners(4) - Corners(1)) * ConvFactor), UserUnits(3)) ' Z axis

      Height = 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(Lenght, Val(UserUnits(2)))

        Length = DecimalToFeetInches(Width, Val(UserUnits(2)))

        Width = DecimalToFeetInches(Height, Val(UserUnits(2)))

      End If

         

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

        retval = Part.AddCustomInfo3(ConfigName, "StockSize", swCustomInfoText, _

                 Height & " x " & Width & " x " & Length)  'Add latest values

       

       

        Exit Sub

      ''End If

       

       

      End Sub

        • Re: Macro modify
          Elmar Klammer

          It easiest to sort the values before you convert it to feet or fractions. Note, your code measures the overall dimensions in reference to the main xyz coordinate system. This code won't give you the boundary dimensions for sheetmetals if the part is not aligned / parallel to the xyz coordinate system.

           

           

           

          '======================================================================================

          '- BUBBLE SORT EXAMPLE : 3 NUMBERS (ASCENDING)

          '- The method is to use a "pointer" and check its current position in the array.

          '- If the current number is more than the next then switch their positions in the array.

          '- If a position is changed then set a marker so the pointer goes through again.

          '- The sort is complete when the pointer has gone through the array without change.

          '- Brian Baulsom October 2008

          '=====================================================================================

           

          Sub SORT_()

              Dim MyNumbers(3)

              Dim Pointer As Integer

              Dim Changed As Boolean

              Dim MyTemp

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

              MyNumbers(1) = 30

              MyNumbers(2) = 20

              MyNumbers(3) = 10

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

              Do

                  Changed = False

                  For Pointer = 1 To 3 - 1

                      If MyNumbers(Pointer) > MyNumbers(Pointer + 1) Then

                          MyTemp = MyNumbers(Pointer)

                          MyNumbers(Pointer) = MyNumbers(Pointer + 1)

                          MyNumbers(Pointer + 1) = MyTemp

                          Changed = True

                      End If

                  Next

              Loop While Changed = True

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

              MsgBox (MyNumbers(1) & vbCr & MyNumbers(2) & vbCr & MyNumbers(3) & vbCr)

          End Sub

          • Re: Macro modify
            Deepak Gupta

            Here is updated macro that works with normal settings in units but not fractions