5 Replies Latest reply on Jun 23, 2015 7:42 AM by Tapani Sjoman

    Macro to set kg in units

    Andrea Arfelli

      Hi,

       

      I have some old files that I need to change the unit of measurement (kilogram), there is a macro?

       

      Thanks

        • Re: Macro to set kg in units
          Tapani Sjoman

          boolstatus = swModel.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 3) ' unit #3 = kg

          • Re: Macro to set kg in units
            Keith Rice

            You can record yourself changing the desired document settings with the macro recorder. To use the macro recorder:

             

            1. Tools-->Macro-->Record

            2. Change the desired document properties

            3. Tools-->Macro-->Stop

            4. You will be prompted to save the .swp file

            5. Run the macro in the future by going to Tools-->Macro-->Run, then browse for the .swp you recorded.

             

            You can associate that .swp file with a toolbar button (and they a keyboard shortcut after that). See this blog post.

             

            Keith

            SolidWorks API Training

            • Re: Macro to set kg in units
              Andrea Arfelli

              This is the macro for: kg,mm,sec

               

              Sub main()

               

               

              Dim swApp           As SldWorks.SldWorks

              Dim swModel         As SldWorks.ModelDoc2

              Dim swSelMgr        As SldWorks.SelectionMgr

              Dim swDispDim       As SldWorks.DisplayDimension

              Dim swDim           As SldWorks.Dimension

              Dim longstatus      As Long

              Dim longwarnings    As Long

              Dim sFileName       As String

              Dim Path            As String

              Dim nErrors         As Long

              Dim nWarnings       As Long

                

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

               

               

              On Error Resume Next

               

               

              Set swApp = Application.SldWorks

                       

                  Path = BrowseFolder()

                  If Path = "" Then

                 

                  MsgBox "Scegli la cartella e prova ancora"

                 

                  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

                    

                  'Edit Mass Units

                  swModel.Extension.SetUserPreferenceInteger swUserPreferenceIntegerValue_e.swUnitSystem, swUserPreferenceOption_e.swDetailingNoOptionSpecified, swUnitSystem_Custom

                 

                  swModel.Extension.SetUserPreferenceInteger swUserPreferenceIntegerValue_e.swUnitsMassPropMass, swUserPreferenceOption_e.swDetailingNoOptionSpecified, swUnitsMassPropMass_Kilograms

                 

                  'Edit Linear Units

                  swModel.SetUserPreferenceIntegerValue swUnitsLinear, swMM

                 

                  'Edit Time Units

                  swModel.Extension.SetUserPreferenceInteger swUserPreferenceIntegerValue_e.swUnitsTimeUnits, swUserPreferenceOption_e.swDetailingNoOptionSpecified, swUnitsTimeUnit_Second

                  

                  'Rebuild, Save and Close the file

                  swModel.EditRebuild3

                  swModel.Save3 swSaveAsOptions_Silent, nErrors, nWarnings

                  swApp.CloseDoc swModel.GetTitle

                

              Set swModel = Nothing

                

              sFileName = Dir

                

              Loop

               

               

              End Sub

                • Re: Macro to set kg in units
                  Tapani Sjoman

                  Here also few lines if you want to set number of decimals in the mass:

                   

                  Dim Val2 As Integer

                  Dim swModExt   As ModelDocExtension

                  Dim MassProp   As MassProperty

                   

                  ' check if need some decimals for under 5 kg models
                  Set swModExt = swModel.Extension
                  Set MassProp = swModExt.CreateMassProperty

                   

                  Val2 = 0  ' no decimals but under 5 kg one decimal and under 0,5 kg two decimals
                  If (MassProp.Mass < 5) Then Val2 = 1
                  If (MassProp.Mass < 0.5) Then Val2 = 2

                  boolstatus = swModel.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swUnitsMassPropDecimalPlaces, Val2)