Updated the load properties from text macro to process all components

Added icons to multi extrude boss-base and set watermark macros

Author: artem1t

solidworks-api/data-storage/custom-properties/link-to-file/Macro.vba

@@ -1,35 +1,59 @@
+Type RefCompModel
+    RefModel As SldWorks.ModelDoc2
+    RefConf As String
+End Type
+
 #Const ARGS = True 'True to use arguments from Toolbar+ or Batch+ instead of the constant
 
 Const CLEAR_PROPERTIES As Boolean = False
+Const ALL_COMPONENTS As Boolean = False
 
 Sub main()
 
     Dim swApp As SldWorks.SldWorks
     Set swApp = Application.SldWorks
 
     Dim swModel As SldWorks.ModelDoc2
-    
-try_:
-    On Error GoTo catch_
 
     Dim csvFilePath As String
     Dim confSpecific As Boolean
 
     If GetParameters(swApp, swModel, csvFilePath, confSpecific) Then
 
         If Not swModel Is Nothing Then
-            WritePropertiesFromFile swModel, csvFilePath, IIf(CBool(confSpecific), swModel.ConfigurationManager.ActiveConfiguration, Nothing)
+            
+            Dim vTable As Variant
+            vTable = GetArrayFromCsv(csvFilePath)
+            
+            Dim swRefConf As SldWorks.Configuration
+            Set swRefConf = swModel.ConfigurationManager.ActiveConfiguration
+            
+            WritePropertiesFromTable swModel, vTable, IIf(CBool(confSpecific), swRefConf.Name, ""), CLEAR_PROPERTIES
+        
+            If ALL_COMPONENTS Then
+            
+                Dim refCompModels() As RefCompModel
+                refCompModels = CollectUniqueComponents(swRefConf, confSpecific)
+                
+                If (Not refCompModels) <> -1 Then
+                    
+                    Dim i As Integer
+                    
+                    For i = 0 To UBound(refCompModels)
+                        WritePropertiesFromTable refCompModels(i).RefModel, vTable, refCompModels(i).RefConf, CBool(clearPrps)
+                    Next
+                    
+                End If
+            
+            End If
+        
+            'WritePropertiesFromFile swModel, csvFilePath, IIf(CBool(confSpecific), swModel.ConfigurationManager.ActiveConfiguration, Nothing)
         Else
             Err.Raise vbError, "", "Please open model"
         End If
 
     End If
 
-    GoTo finally_
-catch_:
-    swmRebuild = Err.Description
-finally_:
-    
 End Sub
 
 Function GetParameters(app As SldWorks.SldWorks, ByRef model As SldWorks.ModelDoc2, ByRef csvFilePath As String, ByRef confSpecific As Boolean) As Boolean
@@ -144,44 +168,25 @@ Function GetArrayFromCsv(filePath As String) As Variant
 
 End Function
 
-Sub WritePropertiesFromFile(model As SldWorks.ModelDoc2, csvFilePath As String, conf As SldWorks.Configuration)
-    
-    If Dir(csvFilePath) = "" Then
-        Err.Raise "Linked CSV file is missing: " & csvFilePath
-    End If
-    
-    Dim vTable As Variant
-    vTable = GetArrayFromCsv(csvFilePath)
+Sub WritePropertiesFromTable(model As SldWorks.ModelDoc2, table As Variant, confName As String, clearPrps As Boolean)
 
     Dim i As Integer
 
-    Dim confName As String
-    
-    If conf Is Nothing Then
-        confName = ""
-    Else
-        confName = conf.Name
-    End If
-    
     Dim swCustPrpMgr As SldWorks.CustomPropertyManager
 
     Set swCustPrpMgr = model.Extension.CustomPropertyManager(confName)
 
-    If UBound(vTable, 2) <> 1 Then
-        Err.Raise vbError, "", "There must be only 2 columns in the CSV file"
-    End If
-    
-    If CLEAR_PROPERTIES Then
+    If clearPrps Then
         ClearProperties swCustPrpMgr
     End If
 
-    For i = 0 To UBound(vTable, 1)
+    For i = 0 To UBound(table, 1)
 
         Dim prpName As String
-        prpName = CStr(vTable(i, 0))
+        prpName = CStr(table(i, 0))
 
         Dim prpVal As String
-        prpVal = CStr(vTable(i, 1))
+        prpVal = CStr(table(i, 1))
 
         If swCustPrpMgr.Add3(prpName, swCustomInfoType_e.swCustomInfoText, prpVal, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue) <> swCustomInfoAddResult_e.swCustomInfoAddResult_AddedOrChanged Then
             Err.Raise vbError, "", "Failed to add property '" & prpName & "'"
@@ -206,4 +211,81 @@ Sub ClearProperties(custPrpMgr As SldWorks.CustomPropertyManager)
 
     End If
 
-End Sub
+End Sub
+
+Function CollectUniqueComponents(assmConf As SldWorks.Configuration, confSpecific As Boolean) As RefCompModel()
+    
+    Dim swRootComp As SldWorks.Component2
+    Set swRootComp = assmConf.GetRootComponent3(False)
+    
+    Dim refCompModels() As RefCompModel
+    
+    ProcessComponents swRootComp.GetChildren(), confSpecific, refCompModels
+    
+    CollectUniqueComponents = refCompModels
+    
+End Function
+
+Sub ProcessComponents(vComps As Variant, confSpecific As Boolean, refCompModels() As RefCompModel)
+    
+    If Not IsEmpty(vComps) Then
+    
+        Dim i As Integer
+        
+        For i = 0 To UBound(vComps)
+            
+            Dim swComp As SldWorks.Component2
+            Set swComp = vComps(i)
+            
+            Dim swRefModel As SldWorks.ModelDoc2
+            Set swRefModel = swComp.GetModelDoc2
+            
+            If Not swRefModel Is Nothing Then
+            
+                Dim refConfName As String
+                
+                refConfName = IIf(confSpecific, swComp.ReferencedConfiguration, "")
+                
+                If Not Contains(refCompModels, swRefModel, refConfName) Then
+                
+                    If (Not refCompModels) = -1 Then
+                        ReDim refCompModels(0)
+                    Else
+                        ReDim Preserve refCompModels(UBound(refCompModels) + 1)
+                    End If
+                    
+                    Set refCompModels(UBound(refCompModels)).RefModel = swRefModel
+                    refCompModels(UBound(refCompModels)).RefConf = refConfName
+                    
+                End If
+                
+                ProcessComponents swComp.GetChildren(), confSpecific, refCompModels
+                
+            End If
+            
+        Next
+    
+    End If
+    
+End Sub
+
+Function Contains(refCompModels() As RefCompModel, model As SldWorks.ModelDoc2, conf As String) As Boolean
+    
+    Contains = False
+    
+    If (Not refCompModels) <> -1 Then
+        
+        Dim i As Integer
+        
+        For i = 0 To UBound(refCompModels)
+                
+            If refCompModels(i).RefModel Is model And LCase(refCompModels(i).RefConf) = LCase(conf) Then
+                Contains = True
+                Exit Function
+            End If
+                
+        Next
+        
+    End If
+    
+End Function

solidworks-api/data-storage/custom-properties/link-to-file/index.md

@@ -24,8 +24,11 @@ Mass,"""SW-Mass"""
 
 Set the value of the **CLEAR_PROPERTIES** constant to **True** or **False** to configure if existing properties need to be deleted before updating.
 
+Set **ALL_COMPONENTS** to **True** to process all components of the assembly
+
 ~~~ vb
 Const CLEAR_PROPERTIES As Boolean = False
+Const ALL_COMPONENTS As Boolean = True
 ~~~
 
 {% code-snippet { file-name: Macro.vba } %}

solidworks-api/document/macro-feature/add-watermark/Icons.zip

@@ -25,11 +25,27 @@ Sub main()
         vMethods(3) = watermarkMacroPath: vMethods(4) = moduleName: vMethods(5) = "swmEditDefinition"
         vMethods(6) = watermarkMacroPath: vMethods(7) = moduleName: vMethods(8) = "swmSecurity"
 
+        Dim iconsDir As String
+        iconsDir = swApp.GetCurrentMacroPathFolder() & "\Icons\"
+        
+        Dim icons(8) As String
+        icons(0) = iconsDir & "watermark_20x20.bmp"
+        icons(1) = iconsDir & "watermark-suppressed_20x20.bmp"
+        icons(2) = iconsDir & "watermark_20x20.bmp"
+        
+        icons(3) = iconsDir & "watermark_32x32.bmp"
+        icons(4) = iconsDir & "watermark-suppressed_32x32.bmp"
+        icons(5) = iconsDir & "watermark_32x32.bmp"
+        
+        icons(6) = iconsDir & "watermark_40x40.bmp"
+        icons(7) = iconsDir & "watermark-suppressed_40x40.bmp"
+        icons(8) = iconsDir & "watermark_40x40.bmp"
+
         Dim swFeat As SldWorks.Feature
 
         Set swFeat = swModel.FeatureManager.InsertMacroFeature3(BASE_NAME, "", vMethods, _
             Empty, Empty, Empty, Empty, Empty, Empty, _
-            Empty, swMacroFeatureOptions_e.swMacroFeatureEmbedMacroFile + swMacroFeatureOptions_e.swMacroFeatureAlwaysAtEnd)
+            icons, swMacroFeatureOptions_e.swMacroFeatureEmbedMacroFile + swMacroFeatureOptions_e.swMacroFeatureAlwaysAtEnd)
 
         If Not swFeat Is Nothing Then
             Dim swSecNote As SldWorks.note

solidworks-api/document/macro-feature/add-watermark/InsertWatermark.vba

@@ -30,6 +30,8 @@ The solution consists of 2 parts:
 
 {% code-snippet { file-name: InsertWatermark.vba } %}
 
+In order to add custom icons, download the [Icons](Icons.zip) file and unzip into the **Icons** sub-folder next to the macro feature file
+
 ## Setting up watermark macro
 
 * Create another new macro

solidworks-api/document/macro-feature/add-watermark/index.md

@@ -75,6 +75,22 @@ Sub InsertMacroFeature(vSketches As Variant, vDepths As Variant)
     vMethods(3) = curMacroPath: vMethods(4) = MACRO_FEATURE_MODULE_NAME: vMethods(5) = "swmEditDefinition"
     vMethods(6) = curMacroPath: vMethods(7) = MACRO_FEATURE_MODULE_NAME: vMethods(8) = "swmSecurity"
 
+    Dim iconsDir As String
+    iconsDir = swApp.GetCurrentMacroPathFolder() & "\Icons\"
+    
+    Dim icons(8) As String
+    icons(0) = iconsDir & "extrude_20x20.bmp"
+    icons(1) = iconsDir & "extrude-suppressed_20x20.bmp"
+    icons(2) = iconsDir & "extrude_20x20.bmp"
+    
+    icons(3) = iconsDir & "extrude_32x32.bmp"
+    icons(4) = iconsDir & "extrude-suppressed_32x32.bmp"
+    icons(5) = iconsDir & "extrude_32x32.bmp"
+    
+    icons(6) = iconsDir & "extrude_40x40.bmp"
+    icons(7) = iconsDir & "extrude-suppressed_40x40.bmp"
+    icons(8) = iconsDir & "extrude_40x40.bmp"
+
     Dim vParamNames As Variant
     Dim vParamTypes As Variant
     Dim vParamValues As Variant
@@ -84,7 +100,7 @@ Sub InsertMacroFeature(vSketches As Variant, vDepths As Variant)
     Dim swFeat As SldWorks.Feature
     Set swFeat = swModel.FeatureManager.InsertMacroFeature3(BASE_NAME, "", vMethods, _
         vParamNames, vParamTypes, vParamValues, Empty, Empty, Empty, _
-        Empty, swMacroFeatureOptions_e.swMacroFeatureEmbedMacroFile)
+        icons, swMacroFeatureOptions_e.swMacroFeatureEmbedMacroFile)
 
     If swFeat Is Nothing Then
         MsgBox "Failed to create feature"

solidworks-api/document/macro-feature/multi-extrude/Controller.vba

@@ -20,6 +20,8 @@ Property Manager pages are defined in the **SolidWorks {{Version}} exposed type
 
 ![VBA macro references](macro-references.png)
 
+In order to add custom icons, download the [Icons](Icons.zip) file and unzip into the **Icons** sub-folder next to the macro feature file
+
 ## Macro Module
 
 Entry point of the macro. Use this to insert new macro feature.