AnsweredAssumed Answered

Help combining macros

Question asked by Tom Hickerson on Mar 12, 2019
Latest reply on Mar 13, 2019 by Tom Hickerson

I have a macro that adds custom properties to every part in an assembly, and one that updates the material type if its not already set.  I was trying to make them run together so, but can't figure out how to pull it off.  I tried different variations but keep running into trouble with the swmodel and swpart


Option Explicit

Dim swApp As SldWorks.SldWorks

Dim swModel As ModelDoc2

Dim vComps As Variant

Dim swComp As SldWorks.Component2

Dim swAssy As SldWorks.AssemblyDoc

Dim i As Integer

'Dim Proj_num As String

Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Debug.Print "Starting with "

'Proj_num = InputBox("Enter Project Number")


'updateProperty swModel, proj_num


If swModel.GetType = swDocASSEMBLY Then

    Set swAssy = swModel

    vComps = swAssy.GetComponents(False)

    For i = 0 To UBound(vComps)

        Set swComp = vComps(i)

        If swComp.GetSuppression = swComponentFullyResolved Then

            Set swModel = swComp.GetModelDoc2

            updateProperty swModel

            changeMet swComp.Name


            MsgBox swComp.Name & " is lightweight or supressed.  Macro stopping"


        End If


    Next i

End If

End Sub


Function updateProperty(swModel As SldWorks.ModelDoc2) As Boolean

Dim cpm As CustomPropertyManager

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

cpm.Add2 "Project", swCustomInfoText, ""

cpm.Add2 "Description", swCustomInfoText, ""

Debug.Print "File " & i & " updated"

End Function


Here is the second one

Option Explicit

Sub main()

  Dim swApp                       As SldWorks.SldWorks

  Dim swModel                     As SldWorks.ModelDoc2

  Dim swPart                      As SldWorks.PartDoc

  Set swApp = Application.SldWorks

  Set swModel = swApp.ActiveDoc

  Set swPart = swModel

  Debug.Print "File = " & swModel.GetPathName

  Debug.Print "  Old part  material   = " & swPart.MaterialIdName

  If swPart.MaterialIdName = "Steel" Or swPart.MaterialIdName = "" Then  ' This item does not have a material set"

   ' Apply new material. This operation overwrites the information in

   ' ModelDoc2::MaterialIdName and PartDoc::MaterialIdName.

   swPart.SetMaterialPropertyName "SolidWorks Materials.sldmat", "ASTM A36 Steel"

  End If

End Sub