2 Replies Latest reply on Oct 29, 2013 8:56 AM by Brian Long

    Macro help, macro pasted in text

    Brian Long

      I have this macro that was created by Filipe Venceslau for adding a custom property called "open area", running an equation and placing the calculated value in the new custom property. I would like to change this so that it is a configuration specific custom property using the current configuration. I have been looking for the correct way to do this, although I don't have a clue on API and need help.

       

       

       

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

      ' Written by Filipe Venceslau on 5/15/2012

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

       

       

      Sub main()

      On Error GoTo msgError

       

       

          'Get solidworks object instance

          Dim swApp As SldWorks.SldWorks

          Set swApp = Application.SldWorks

       

          'Get modeldoc2 object instance from active doc

          Dim Part As SldWorks.ModelDoc2

          Set Part = swApp.ActiveDoc

       

          'Get custom property manager (used to manipulate custom properties)

          Dim cpMgr As SldWorks.CustomPropertyManager

          Set cpMgr = Part.Extension.CustomPropertyManager("")

       

          'Get current config custom property

          Dim swConfig As SldWorks.Configuration

          Set swConfig = swConfigMgr.ActiveConfiguration

       

          'Declare Variables for OpenArea calculation

          Dim dbScaleFactor As Double

          Dim dbBegFaceArea As Double

          Dim dbFaceArea As Double

          Dim dbOpenArea As Double

       

          'Define default Titles

          Dim DefaultTitles(5) As String

          DefaultTitles(0) = "1.250 INSERT"

          DefaultTitles(1) = "BLANK254"

          DefaultTitles(2) = "BLANK481"

          DefaultTitles(3) = "BLANK368"

          DefaultTitles(4) = "BLANK366"

          DefaultTitles(5) = "BLANK8060"

       

          'Define default Values

          Dim DefaultValues(5) As Double

          DefaultValues(0) = 0.73441718

          DefaultValues(1) = 0.4048916

          DefaultValues(2) = 22.77654674

          DefaultValues(3) = 16.89538712

          DefaultValues(4) = 30.51542336

          DefaultValues(5) = 3.14232926

       

          'Build message and get user input

          Dim strMsg As String

          strMsg = "Please select from the following options, or type in desired value" & vbCrLf & vbCrLf

          For i = 0 To UBound(DefaultTitles)

              strMsg = strMsg & i + 1 & vbTab & DefaultTitles(i) & vbTab & DefaultValues(i) & vbCrLf

          Next

          Dim dbUserInput As Double

          dbUserInput = InputBox(strMsg, "Beginning Face Area", 1)

          Select Case dbUserInput

              Case 1, 2, 3, 4, 5, 6

                  dbBegFaceArea = DefaultValues(dbUserInput - 1)

              Case Else

                  dbBegFaceArea = dbUserInput

          End Select

       

          'Assign values and calculate variables

          dbScaleFactor = 1550.003

          dbFaceArea = Part.FeatureByName("MYSURFACE").GetBody.GetFirstFace.GetArea * dbScaleFactor

          dbOpenArea = Round(dbBegFaceArea - dbFaceArea, 6)

       

          'Delete Custom Prop

          cpMgr.swConfig.Delete ("OpenArea")

       

          'Add Custom Prop

          Call cpMgr.swConfig.Add2("OpenArea", swCustomInfoType_e.swCustomInfoText, dbOpenArea)

       

          'Notify user and exit

          MsgBox "Done", vbInformation

          Exit Sub

       

      msgError:

          'msg error when error occurs

          MsgBox Err.Description, vbCritical

       

      End Sub

        • Re: Macro help, macro pasted in text
          Artem Taturevych

          Check this revised macro:

           

          Sub main()

          On Error GoTo msgError

           

           

              'Get solidworks object instance

              Dim swApp As SldWorks.SldWorks

              Set swApp = Application.SldWorks

           

              'Get modeldoc2 object instance from active doc

              Dim Part As SldWorks.ModelDoc2

              Set Part = swApp.ActiveDoc

           

              'Get custom property manager (used to manipulate custom properties)

              Dim cpMgr As SldWorks.CustomPropertyManager

              Set cpMgr = Part.Extension.CustomPropertyManager(Part.ConfigurationManager.ActiveConfiguration.Name)

           

              'Declare Variables for OpenArea calculation

              Dim dbScaleFactor As Double

              Dim dbBegFaceArea As Double

              Dim dbFaceArea As Double

              Dim dbOpenArea As Double

           

              'Define default Titles

              Dim DefaultTitles(5) As String

              DefaultTitles(0) = "1.250 INSERT"

              DefaultTitles(1) = "BLANK254"

              DefaultTitles(2) = "BLANK481"

              DefaultTitles(3) = "BLANK368"

              DefaultTitles(4) = "BLANK366"

              DefaultTitles(5) = "BLANK8060"

           

              'Define default Values

              Dim DefaultValues(5) As Double

              DefaultValues(0) = 0.73441718

              DefaultValues(1) = 0.4048916

              DefaultValues(2) = 22.77654674

              DefaultValues(3) = 16.89538712

              DefaultValues(4) = 30.51542336

              DefaultValues(5) = 3.14232926

           

              'Build message and get user input

              Dim strMsg As String

              strMsg = "Please select from the following options, or type in desired value" & vbCrLf & vbCrLf

              For i = 0 To UBound(DefaultTitles)

                  strMsg = strMsg & i + 1 & vbTab & DefaultTitles(i) & vbTab & DefaultValues(i) & vbCrLf

              Next

              Dim dbUserInput As Double

              dbUserInput = InputBox(strMsg, "Beginning Face Area", 1)

              Select Case dbUserInput

                  Case 1, 2, 3, 4, 5, 6

                      dbBegFaceArea = DefaultValues(dbUserInput - 1)

                  Case Else

                      dbBegFaceArea = dbUserInput

              End Select

           

              'Assign values and calculate variables

              dbScaleFactor = 1550.003

              dbFaceArea = Part.FeatureByName("MYSURFACE").GetBody.GetFirstFace.GetArea * dbScaleFactor

              dbOpenArea = Round(dbBegFaceArea - dbFaceArea, 6)

           

              'Delete Custom Prop

              cpMgr.Delete ("OpenArea")

           

              'Add Custom Prop

              Call cpMgr.Add2("OpenArea", swCustomInfoType_e.swCustomInfoText, dbOpenArea)

           

              'Notify user and exit

              MsgBox "Done", vbInformation

              Exit Sub

           

          msgError:

              'msg error when error occurs

              MsgBox Err.Description, vbCritical

           

          End Sub

           

          ____________________________________________________

          Regards,

          Artem Taturevych, Application Engineer at Intercad (Australia)

           

          translationXpert – add-in to translate SolidWorks models

          myIntercad an integrated tool for SolidWorks Professionals

          LinkedIn SolidWorks API Education Group