AnsweredAssumed Answered

Macro modify

Question asked by Antonio Cavka on Jul 18, 2016
Latest reply on Jul 21, 2016 by 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

Outcomes