VBA to Minimize Solidworks from Solidworks OR Excel

[Rekd]

I've been trying to find VBA code to minimize the Solidworks window.

I want to close the current doc then minimize SW, I've got the close current doc part using swApp.CloseDoc (OpenDoc) but can't figure out how to minimize. I've tried various versions of Application.Windowstate=1 but it doesn't work.

 

[kjv1611]

You may want to see about using something like this:

http://www.lennyworks.com/solidworks/default.asp?ID=30

Then again, maybe you're already using it?

 

[Rekd]

Thanks for the reply.

Yes, I use Lenny's quite a bit but I couldn't find anything for what I need there.

 

[SkipVought]

I'd start out from Excel, set an application object of the Solidworks application and see if the solidworks applicaion has a minimize property.

Check out the Solidworks Object Model.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Rekd]

I've been doing most of my coding in Excel, including this. I looked through the object model and couldn't find any referenc to the SW Window.

 

[SkipVought]

I've been doing most of my coding in Excel,

Please post your code.

Have you set a reference to the Solidworks Object Library in Tools > References?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Rekd]

I haven't kept any code because I can't get it to work (see below).

I've got the close current doc part using swApp.CloseDoc (OpenDoc) but can't figure out how to minimize. I've tried various versions of Application.Windowstate=1 but it doesn't work.

I do have a reference to Soliworks ad I have been able to close open docs from Excel...

 

[SkipVought]

I do have a reference to Soliworks ad I have been able to close open docs from Excel...

but you've discarded ALL your code? REALLY??? WHY?

FYI. I'd also search for Solidworks in the Advanced Search in the FORUMS tab at the TOP of this page.




Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Rekd]

The code I tried and deleted was typed into existing code that's used for somethig else. It was only a line at a time and I didn't keep it because it didn't work.

If you want to see the code it's below, if another user can use it that's great. Its a fairly large macro that I run from Excel. It opens a solidworks file based on a cells value, get's the model's length, width and height, then populates a spreadsheet with the data so I can calculate the material's cost.

I tried the search function both here and at one of the sister sites, Eng Tips, and didn't find anything.

Here's the code that's opening/grabbing data from Solidworks and putting it into Excel...

' Get box size, send to Material Calculator sheet
' NOTE: This can't run from ASC because users will not have the required DLL
' To do
' Verify if SW is running, if not, start it.
' Verify that selection is on Column A
' Try to verify if current part in SW is selected part on Estimates
' When confident we have the right part, get Units (in current box code)
' Consider option to send current price from Mat'l Calc to Estimates

Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim Height As Variant
Dim Width As Variant
Dim Length As Variant
Dim Volume As Variant
Dim BoxSize As Variant
Dim Corners As Variant
Dim retval As Boolean
Dim UserUnits As Variant
Dim ConvFactor As Double
Dim AddFactor As Double
Dim ConfigName  As String
Dim SwConfig As SldWorks.Configuration
Dim MsgResponse As Integer
Dim swSketchPt(8) As SldWorks.SketchPoint
Dim swSketchSeg(12) As SldWorks.SketchSegment

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

' **********************************************************************
' * This macro gets the bounding box dimensions for the config specific
' * model and adds a small amount to it.  This amount can be changed
' * by modifying the "AddFactor" value below.  It checks to make sure
' * you have a proper document open.  It checks & utilizes the user units.
' * It will add 3 separate properties or combine them all into one property.
' * It will optionally draw a 3D sketch for you.
' *
' * 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.
' **********************************************************************


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)

  ' compute whole inches
  intInches = Int(remainder)
  remainder = remainder - intInches
   
  ' compute fractional inches & check for division by zero
  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  ' Round up so bounding box is always larger.
            intFractions = intFractions + 1
          End If
        End If
     End If
  End If
      'Debug.Print "Feet = " & intFeet & ", Inches = " & intInches & ", Numerator = " & intFractions & ", Denominator = " & FractToDecimal
  Call FractUp(intFeet, intInches, intFractions, Denominator) ' Simplify up & down
  
  ' format output
  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)
      'Debug.Print DecimalToFeetInches

End Function

Function FractUp(InputFt As Integer, InputInch As Integer, InputNum As Integer, InputDenom As Integer)
    
       'Debug.Print InputFt, InputInch, InputNum, InputDenom
  
  ' Simplify the fractions, Example: 6/8" becomes 3/4"
  While InputNum Mod 2 = 0 And InputDenom Mod 2 = 0
    InputNum = InputNum / 2
    InputDenom = InputDenom / 2
  Wend
  
  ' See if we now have a full inch or 12 inches.  If so, bump stuff up
  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
       'Debug.Print InputFt, InputInch, InputNum, InputDenom
        
End Function

Function GetCurrentConfigName()
  
  Set SwConfig = Part.GetActiveConfiguration  ' See what config we are now on & set the variable
  GetCurrentConfigName = Part.GetActiveConfiguration.Name  ' Return the name

End Function

Sub DrawBox()
    
  Part.Insert3DSketch2 True
  Part.SetAddToDB True
  Part.SetDisplayWhenAdded False

  'Draw points at each corner of bounding box
  Set swSketchPt(0) = Part.CreatePoint2(Corners(3), Corners(1), Corners(5))
  Set swSketchPt(1) = Part.CreatePoint2(Corners(0), Corners(1), Corners(5))
  Set swSketchPt(2) = Part.CreatePoint2(Corners(0), Corners(1), Corners(2))
  Set swSketchPt(3) = Part.CreatePoint2(Corners(3), Corners(1), Corners(2))
  Set swSketchPt(4) = Part.CreatePoint2(Corners(3), Corners(4), Corners(5))
  Set swSketchPt(5) = Part.CreatePoint2(Corners(0), Corners(4), Corners(5))
  Set swSketchPt(6) = Part.CreatePoint2(Corners(0), Corners(4), Corners(2))
  Set swSketchPt(7) = Part.CreatePoint2(Corners(3), Corners(4), Corners(2))
  
  ' Now draw bounding box
  Set swSketchSeg(0) = Part.CreateLine2(swSketchPt(0).X, swSketchPt(0).Y, swSketchPt(0).z, swSketchPt(1).X, swSketchPt(1).Y, swSketchPt(1).z)
  Set swSketchSeg(1) = Part.CreateLine2(swSketchPt(1).X, swSketchPt(1).Y, swSketchPt(1).z, swSketchPt(2).X, swSketchPt(2).Y, swSketchPt(2).z)
  Set swSketchSeg(2) = Part.CreateLine2(swSketchPt(2).X, swSketchPt(2).Y, swSketchPt(2).z, swSketchPt(3).X, swSketchPt(3).Y, swSketchPt(3).z)
  Set swSketchSeg(3) = Part.CreateLine2(swSketchPt(3).X, swSketchPt(3).Y, swSketchPt(3).z, swSketchPt(0).X, swSketchPt(0).Y, swSketchPt(0).z)
  Set swSketchSeg(4) = Part.CreateLine2(swSketchPt(0).X, swSketchPt(0).Y, swSketchPt(0).z, swSketchPt(4).X, swSketchPt(4).Y, swSketchPt(4).z)
  Set swSketchSeg(5) = Part.CreateLine2(swSketchPt(1).X, swSketchPt(1).Y, swSketchPt(1).z, swSketchPt(5).X, swSketchPt(5).Y, swSketchPt(5).z)
  Set swSketchSeg(6) = Part.CreateLine2(swSketchPt(2).X, swSketchPt(2).Y, swSketchPt(2).z, swSketchPt(6).X, swSketchPt(6).Y, swSketchPt(6).z)
  Set swSketchSeg(7) = Part.CreateLine2(swSketchPt(3).X, swSketchPt(3).Y, swSketchPt(3).z, swSketchPt(7).X, swSketchPt(7).Y, swSketchPt(7).z)
  Set swSketchSeg(8) = Part.CreateLine2(swSketchPt(4).X, swSketchPt(4).Y, swSketchPt(4).z, swSketchPt(5).X, swSketchPt(5).Y, swSketchPt(5).z)
  Set swSketchSeg(9) = Part.CreateLine2(swSketchPt(5).X, swSketchPt(5).Y, swSketchPt(5).z, swSketchPt(6).X, swSketchPt(6).Y, swSketchPt(6).z)
  Set swSketchSeg(10) = Part.CreateLine2(swSketchPt(6).X, swSketchPt(6).Y, swSketchPt(6).z, swSketchPt(7).X, swSketchPt(7).Y, swSketchPt(7).z)
  Set swSketchSeg(11) = Part.CreateLine2(swSketchPt(7).X, swSketchPt(7).Y, swSketchPt(7).z, swSketchPt(4).X, swSketchPt(4).Y, swSketchPt(4).z)

  Part.SetDisplayWhenAdded True
  Part.SetAddToDB False
  Part.Insert3DSketch2 True

End Sub

Sub BoundingBox()
Call ViewPRT
AddFactor = 0#  ' This is the amount added - change to suit

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()
  'Debug.Print "LengthUnit = " & UserUnits(0)
  'Debug.Print "Fraction Base = " & UserUnits(1)
  'Debug.Print "FractionDenominator = " & UserUnits(2)
  'Debug.Print "SignificantDigits = " & UserUnits(3)
  'Debug.Print "RoundToFraction = " & UserUnits(4)
  
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) + AddFactor, UserUnits(3)) ' Z axis
Width = Round((Abs(Corners(5) - Corners(2)) * ConvFactor) + AddFactor, UserUnits(3))  ' Y axis
Length = Round((Abs(Corners(3) - Corners(0)) * ConvFactor) + AddFactor, UserUnits(3)) ' X axis
    'Debug.Print Height & " x " & Width & " x " & Length

' 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
    'Debug.Print Height & " x " & Width & " x " & Length

'Get volume of stock size
Volume = Round(Length * Width * Height, 2)

'''ConfigName = GetCurrentConfigName() ' See what config we are now on

'''MsgBoxMsg = "The default for this program is to combine the 3 values into one property." & Chr$(13) & Chr$(10) _
        & "Do you want to keep it this way?" & Chr$(13) & Chr$(10) _
        & Chr$(10) & "(Clicking the No button will add 3 separate properties.)"

'''MsgResponse = MsgBox(MsgBoxMsg, vbInformation + vbYesNoCancel)
' Get largest size (For commcode)
BoxSize = Length
If BoxSize < Width Then BoxSize = Width
If BoxSize < Height Then BoxSize = Height

'MsgBox "LxWxH :" & Format(Length, "##,##0.00") & " x " & Format(Width, "##,##0.00") & " x " & Format(Height, "##,##0.00") & vbCrLf & "Box Size is " & Format(BoxSize, "##,##0.00")
    
    'Put values into Excel
    CurrRow = ActiveCell.Row
    
    Range("W" & CurrRow).Value = Length
    Range("X" & CurrRow).Value = Width
    Range("Y" & CurrRow).Value = Height
    Range("U" & CurrRow).Value = Volume
    Sheets("Material Calculator").Select
    Range("B3").Value = Height
    Range("B4").Value = Width
    Range("B5").Value = Length
    
'''''''''    Range("A1").Select
'''''''''    ActiveCell.Value = Format(BoxSize, "##,##0.00")
'''If MsgResponse = vbYes Then  ' One property
  retval = Part.DeleteCustomInfo2(ConfigName, "BoundingSize") 'Remove existing properties
  retval = Part.AddCustomInfo3(ConfigName, "BoundingSize", swCustomInfoText, _
           Height & " x " & Width & " x " & Length)  'Add latest values
'''ElseIf MsgResponse = vbNo Then  ' 3 properties
  'Remove existing properties
  retval = Part.DeleteCustomInfo2(ConfigName, "Height")
  retval = Part.DeleteCustomInfo2(ConfigName, "Width")
  retval = Part.DeleteCustomInfo2(ConfigName, "Length")
  'Add latest values
  retval = Part.AddCustomInfo3(ConfigName, "Height", swCustomInfoNumber, Height)
  retval = Part.AddCustomInfo3(ConfigName, "Width", swCustomInfoNumber, Width)
  retval = Part.AddCustomInfo3(ConfigName, "Length", swCustomInfoNumber, Length)
  'Volume
  retval = Part.DeleteCustomInfo2(ConfigName, "Volume")
  retval = Part.AddCustomInfo3(ConfigName, "Volume", swCustomInfoNumber, Volume)

'''Else
  Exit Sub
'''End If

MsgBoxMsg = "Do you want to draw a 3D sketch that represents the bounding box?" & Chr$(13) & Chr$(10) _
        & "This is a good way to visualize the dimensions."

MsgResponse = MsgBox(MsgBoxMsg, vbInformation + vbYesNo)

If MsgResponse = vbYes Then Call DrawBox

End Sub