AnsweredAssumed Answered

Macro help, macro pasted in text

Question asked by Brian Long on Oct 28, 2013
Latest reply on Oct 29, 2013 by 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

Outcomes