Hi
I created maro to insert values into all parts of the assembly. After entering the values "save all". Everything worked great in version 2017 and 2018, but 2021 not. After reopening assembly the values are gone. Any suggestions?
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 wo_num As String
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
wo_num = InputBox("Project Name")
updateProperty1 swModel, wo_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
updateProperty1 swModel, wo_num
Else
End If
Next i
End If
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
wo_num = InputBox("Cislo Dilu: Teil-Nr")
updateProperty2 swModel, wo_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
updateProperty2 swModel, wo_num
Else
End If
Next i
End I
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
wo_num = InputBox("Nazev Dilu: Teil-Benennung")
updateProperty3 swModel, wo_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
updateProperty3 swModel, wo_num
Else
End If
Next i
End If
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
wo_num = InputBox("wzg Bennenung")
updateProperty4 swModel, wo_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
updateProperty4 swModel, wo_num
Else
End If
Next i
End If
End Sub
Function updateProperty1(swModel As SldWorks.ModelDoc2, mValue As String) As Boolean
Dim cpm As CustomPropertyManager
Set cpm = swModel.Extension.CustomPropertyManager("")
cpm.Add3 "Project Name", swCustomInfoText, mValue, 1
End Function
Function updateProperty2(swModel As SldWorks.ModelDoc2, mValue As String) As Boolean
Dim cpm As CustomPropertyManager
Set cpm = swModel.Extension.CustomPropertyManager("")
cpm.Add3 "Cislo Dilu", swCustomInfoText, mValue, 1
End Function
Function updateProperty3(swModel As SldWorks.ModelDoc2, mValue As String) As Boolean
Dim cpm As CustomPropertyManager
Set cpm = swModel.Extension.CustomPropertyManager("")
cpm.Add3 "Nazev Dilu", swCustomInfoText, mValue, 1
End Function
Function updateProperty4(swModel As SldWorks.ModelDoc2, mValue As String) As Boolean
Dim cpm As CustomPropertyManager
Set cpm = swModel.Extension.CustomPropertyManager("")
cpm.Add3 "wzg Bennenung", swCustomInfoText, mValue, 1
End Function