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
Else
MsgBox swComp.Name & " is lightweight or supressed. Macro stopping"
End
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