ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
THTom Hickerson12/03/2019

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