Im finding chat jippety very apt with vba macros.
for example i had an old macro that worked in a part environment and asked for it to also work from an assembly by collecting all the unique modeldocs.
heres what it wrote
worked first time but i needed to add a swPart.SetSaveFlag was all. amazing!
Option Explicit
' ... (same as before: declarations, constants, ...)
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
PropAddedCount = 0
If swModel Is Nothing Then Exit Sub
Dim DocType As Long
DocType = swModel.GetType
If DocType = swDocumentTypes_e.swDocPART Then
ProcessPart swModel
ElseIf DocType = swDocumentTypes_e.swDocASSEMBLY Then
ProcessAssemblyComponents swModel
Else
Call swApp.SendMsgToUser2("This macro only works for part and assembly documents.", swMessageBoxIcon_e.swMbInformation, swMessageBoxBtn_e.swMbOk)
End If
Call swApp.SendMsgToUser2("Added " & PropAddedCount & " Properties", swMessageBoxIcon_e.swMbInformation, swMessageBoxBtn_e.swMbOk)
End Sub
Private Sub ProcessPart(swPartModel As SldWorks.ModelDoc2)
Updates False
Set swConfig = swPartModel.GetActiveConfiguration
Dim ActiveConfigName As String
ActiveConfigName = swConfig.Name
Dim vConfigNames As Variant
vConfigNames = swPartModel.GetConfigurationNames
Dim ConfigName As String
Dim i As Long
For i = 0 To UBound(vConfigNames)
ConfigName = vConfigNames(i)
Call swPartModel.ShowConfiguration2(ConfigName)
Set swConfig = swPartModel.GetActiveConfiguration
Debug.Print ConfigName
Call DoShiz(swConfig.CustomPropertyManager)
Next i
Call swPartModel.ShowConfiguration2(ActiveConfigName)
Updates True
End Sub
Private Sub ProcessAssemblyComponents(swAssemModel As SldWorks.ModelDoc2)
Dim swAssy As SldWorks.AssemblyDoc
Set swAssy = swAssemModel
Dim CompArr As Variant
CompArr = swAssy.GetComponents(False)
Dim Comp As SldWorks.Component2
Dim swPart As SldWorks.ModelDoc2
Dim i As Long
Dim UniqueParts As Object
Set UniqueParts = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(CompArr)
Set Comp = CompArr(i)
Set swPart = Comp.GetModelDoc2
If Not UniqueParts.Exists(swPart.GetPathName) Then
UniqueParts.Add swPart.GetPathName, swPart
ProcessPart swPart
End If
Next i
Set UniqueParts = Nothing
End Sub
' ... (same as before: DoShiz, Updates, ...)
