Mass Properties VB

Can anyone help?
I'm trying to set the density of a model by entering the mass (in kg)
using VB6, so that I can record mass of bought out items eg motors etc.
I was able to do it before using the following code but it doesn't work
anymore. The API help file doesn't help, I've tried all methods but
keep getting errors.
The idea is to enter the mass in a text box and click abutton to set
the density.
Code:

Private Sub cmdCalc_Click()

Dim massProps As Variant
Dim Den, Mass As Variant
Dim Vol As Variant
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc
Const swMaterialPropertyDensity = 7

massProps = Part.GetMassProperties ' Get the mass properties

Vol = massProps(3)
Mass = txtMass.Text
Den = Mass / massProps(3)
txtDensity.Text = Den
Retval = Part.SetUserPreferenceDoubleValue(swMaterialPropertyDensity,
txtDensity.Text)
'sets density for model

End Sub

Thanks in advance

 

It works just fine for me, what are the errors that you are getting?

 

The important calls to GetMassProperties and
SetUserPreferenceDoubleValue work for me.

 

I rewrote this as a SW macro. Could be very handy to those of us in the
IPS world.

One interesting thing is that if you set a unit cube to 1 pound with
the macro it ends up being slightly less than a pound.

'
******************************************************************************
' macro recorded on 05/27/05 by kellnerp
'
******************************************************************************
Const swMaterialPropertyDensity = 7
Const kg2lb As Double = 2.20462262
Const lb2kg As Double = 0.453592337

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Dim Mass As Double


Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

'Debug.Print ips2mks * lb2kg
Mass = GetMass()

Call MassCalc(Mass)

End Sub
Private Sub MassCalc(Mass As Double)

Dim massProps() As Double
Dim Den As Double
Dim Vol As Double


massProps = Part.GetMassProperties ' Get the mass properties

Vol = massProps(3)

Den = Mass * lb2kg / massProps(3)

'sets density for model
Retval = Part.SetUserPreferenceDoubleValue(swMaterialPropertyDensity,
Den)


End Sub

Private Function GetMass() As Double

Dim Message, Title, Default As String

' Set prompt.
Message = "Enter mass in pounds: "
Title = "SET MASS" ' Set title.
Default = "1.000" ' Set default.

' Display message, title, and default value.
GetMass = Val(InputBox(Message, Title, Default, 200, 200))

End Function

 

I think I know whats wrong, I need a copy of swconst.bas to include in
my programme.
I've searched the Solidworks site but can't find it, does anyone have a
copy to send me?

Thanks

 

Hi Bob,

starting with SolidWorks 2004 there is no more swconst.bas, but you
have to place a reference to "SolidWorks XXXX Constant type library"
from Tools/references in VBA editor (don't Know exactly, which menu
this is in english environment). However, this has one downside: the
reference is not compatible between major versions of SolidWorks.

This is the reason I also prefer the good, old swconst.bas (usually I
copy only the 5 or 10 constant I need and paste the directly in the
macro) and I therefor I make the swconst.bas on my own. If you want to
download them take a look at my website
http://swtools.cad.de/macros.htm and scroll all the way down, there is
a version for 2004. If you need those for 2005 you may look at my
(german) webpage http://solidworks.cad.de/mm_997.htm . I'll update both
pages this weekend for the newest servicepacks and major versions

HTH,
Stefan