6 Replies Latest reply on Mar 18, 2016 4:47 AM by Deepak Gupta

    Macro to Fix Assigned Mass Properties

    Paul Ryan

      I have a macro that extracts Mass Properties for each part/assembly in a master assembly.  If any part has assigned mass properties, that branch will not yield the correct mass properties.  The easiest way to fix this manually is to get the assigned mass divide by the calculated volume and created a new material with new density and assign it to this part.  I have assemblies with a lot of these assigned mass properties and it is very diffucult/time consuming to do this.  How would I do this in a macro?  I can get the calculated volume but I have trouble figuring out if Mass Properties are assigned.  I am also unsure how to assign a new material to accomplish my goal.

        • Re: Macro to Fix Assigned Mass Properties
          Deepak Gupta

          You can use the following code to know if mass properties are overridden OR not:

           

          Dim swApp       As SldWorks.SldWorks

          Dim swModel     As SldWorks.ModelDoc2

          Dim MassProp    As SldWorks.MassProperty

           

          Sub main()

          Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

           

          Set MassProp = swModel.Extension.CreateMassProperty

           

          If MassProp.OverrideMass Then

          MsgBox "Mass Properties are overridden!!"

          Else

          MsgBox "Mass Properties are not overridden!!"

          End If

           

          End Sub

            • Re: Macro to Fix Assigned Mass Properties
              Paul Ryan

              OverrideMass seems to be a new IMassProperty member starting in 2013.  Unfortunately I am still using 2012.  However, the UserAssigned member seems do what I need.  I just need to be able to create a material now.

              • Re: Macro to Fix Assigned Mass Properties
                Alex Henry

                Hi Deepak Gupta

                I used your invaluable Mass Properties to part macro shared from another post attached - I wanted to tell the property to put the value kg at the end. Not knowing anythign about macros, I thought I could add "kg" as part of the property but unfortunately this added the file property as so:

                 

                 

                I realise then I need some sort of String - do you know what I should do with that to add the text kg at the end of the mass properties as well as change the units to kg (please contact me directly if you wish not to share freely here)? You can see below it's in grams, not kg

                 

                 

                ' Batch Add Mass Custom Property (Parts only).swp------------------------------07/03/14

                 

                 

                'Folder Browse Codes: http://www.cpearson.com/excel/browsefolder.aspx

                 

                 

                ' Description: Macro to add custom Mass Property in all parts files in the specified location.

                 

                 

                ' This macro is provided as is.  No claims, support, refund, safety net, or

                ' warranties are expressed or implied.  By using this macro and/or its code in

                ' any way whatsoever, the user and any entities which the user represents,

                ' agree to hold the authors free of any and all liability.  Free distribution

                ' and use of this code in other free works is welcome.  If any portion of

                ' this code is used in other works, credit to the authors must be placed in

                ' that work within a user viewable location (e.g., macro header).  All other

                ' forms of distribution (i.e., not free, fee for delivery, etc) are prohibited

                ' without the expressed written consent by the authors.  Use at your own risk!

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

                ' Written by: Deepak Gupta (http://gupta9665.com/)

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

                Option Explicit

                 

                 

                Private Const BIF_RETURNONLYFSDIRS As Long = &H1

                Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2

                Private Const BIF_RETURNFSANCESTORS As Long = &H8

                Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000

                Private Const BIF_BROWSEFORPRINTER As Long = &H2000

                Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000

                Private Const MAX_PATH As Long = 260

                Function BrowseFolder(Optional Caption As String, _

                    Optional InitialFolder As String) As String

                 

                 

                Dim SH As Shell32.Shell

                Dim F As Shell32.Folder

                 

                 

                Set SH = New Shell32.Shell

                Set F = SH.BrowseforFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)

                If Not F Is Nothing Then

                    BrowseFolder = F.Items.Item.Path

                End If

                 

                 

                End Function

                 

                Sub main()

                Dim swApp As SldWorks.SldWorks

                Dim swModel As ModelDoc2

                Dim swModelDocExt As ModelDocExtension

                Dim swCustProp As CustomPropertyManager

                Dim sFileName    As String, Path As String

                Dim longstatus   As Long, longwarnings As Long

                Dim val As String, nProp As String

                Dim valout As String

                Dim retVal As Long

                 

                 

                On Error Resume Next

                 

                 

                    Set swApp = Application.SldWorks

                       

                    Path = BrowseFolder("Select a Path/Folder")

                    If Path = "" Then

                    MsgBox "Please select the path and try again"

                    End

                    Else

                    Path = Path & "\"

                    End If

                  

                    sFileName = Dir(Path & "*.sldprt")

                    Do Until sFileName = ""

                    Set swModel = swApp.OpenDoc6(Path + sFileName, swDocPART, swOpenDocOptions_Silent, "", longstatus, longwarnings)

                    Set swModel = swApp.ActiveDoc

                         

                    swModel.AddCustomInfo2 "Mass", swCustomInfoText, Chr(34) & "SW-Mass" & "@" & swModel.GetTitle & ".SLDPRT" & kg & Chr(34)

                    swModel.Save

                    swApp.CloseDoc swModel.GetTitle

                      

                Set swModel = Nothing

                sFileName = Dir

                  

                Loop

                End Sub

                  • Re: Macro to Fix Assigned Mass Properties
                    Deepak Gupta

                    Alex, replace this line

                     

                     

                    swModel.AddCustomInfo2 "Mass", swCustomInfoText, Chr(34) & "SW-Mass" & "@" & swModel.GetTitle & ".SLDPRT" & kg & Chr(34)

                     

                    with these lines

                    swModel.Extension.SetUserPreferenceInteger swUserPreferenceIntegerValue_e.swUnitSystem, 0, swUnitSystem_e.swUnitSystem_Custom
                    swModel.Extension.SetUserPreferenceInteger swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, swUnitsMassPropMass_e.swUnitsMassPropMass_Kilograms
                    Set swCustProp = swModel.Extension.CustomPropertyManager("")swCustProp.Add2 "Mass", swCustomInfoText, Chr(34) & "SW-Mass" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34) & " KG"
                    swCustProp.Set "Mass", Chr(34) & "SW-Mass" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34) & " KG"
                    swModel.ForceRebuild3 (False)
                    
                      • Re: Macro to Fix Assigned Mass Properties
                        Alex Henry

                        I was writing this earlier - and wanted to say a big thank you - got caught up in my other design work.

                         

                        Anyway, I copies your text and replaced but had a compile and syntax error rgarding the following part - I couldnt capture it but VB highlighted the following text. Not sure whether you can comment on that - again, if this is a pain for you, you can contact me at alex henry design as one word at g mail dot com

                         

                        swCustProp as part of the text below. I used kg (kilograms) in line with scientific notation. 

                         

                            swModel.Extension.SetUserPreferenceInteger swUserPreferenceIntegerValue_e.swUnitSystem, 0, swUnitSystem_e.swUnitSystem_Custom

                            swModel.Extension.SetUserPreferenceInteger swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, swUnitsMassPropMass_e.swUnitsMassPropMass_Kilograms

                            Set swCustProp = swModel.Extension.CustomPropertyManager("")swCustProp.Add2 "Mass", swCustomInfoText, Chr(34) & "SW-Mass" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34) & " kg"

                            swCustProp.Set "Mass", Chr(34) & "SW-Mass" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34) & " kg"

                            swModel.ForceRebuild3 (False)

                          • Re: Macro to Fix Assigned Mass Properties
                            Deepak Gupta

                            Alex Henry wrote:

                             

                            Set swCustProp = swModel.Extension.CustomPropertyManager("")swCustProp.Add2 "Mass", swCustomInfoText, Chr(34) & "SW-Mass" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34) & " kg"

                            These are two separate lines but somehow became one.

                             

                            Correct lines

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

                            swCustProp.Add2 "Mass", swCustomInfoText, Chr(34) & "SW-Mass" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34) & " kg"

                            Check and see if this works.