Merge from master

solidworks-api/document/appearance/color-assembly/Macro.vba

@@ -0,0 +1,196 @@
+Const COMP_LEVEL As Boolean = True
+Const PARTS_ONLY As Boolean = True
+Const ALL_CONFIGS As Boolean = True
+Const PRP_NAME As String = ""
+
+Dim swApp As SldWorks.SldWorks
+Dim ColorsMap As Object
+
+Sub InitColors(Optional dummy As Variant = Empty)
+
+    ColorsMap.Add "Plate", RGB(255, 0, 0)
+    ColorsMap.Add "Beam", RGB(0, 255, 0)
+
+End Sub
+
+Sub main()
+
+try_:
+
+    On Error GoTo catch_
+
+    Set ColorsMap = CreateObject("Scripting.Dictionary")
+
+    ColorsMap.CompareMode = vbTextCompare
+
+    InitColors
+
+    Set swApp = Application.SldWorks
+
+    Dim swModel As SldWorks.ModelDoc2
+
+    Set swModel = swApp.ActiveDoc
+
+    If Not swModel Is Nothing Then
+
+        If swModel.GetType() = swDocumentTypes_e.swDocASSEMBLY Then
+
+            Dim swAssy As SldWorks.AssemblyDoc
+
+            Set swAssy = swModel
+
+            swAssy.ResolveAllLightWeightComponents True
+
+            Dim vComps As Variant
+            vComps = swAssy.GetComponents(False)
+
+            ColorizeComponents vComps
+
+            swModel.GraphicsRedraw2
+        Else
+            Err.Raise vbError, "", "Only assembly document is supported"
+        End If
+    Else
+        Err.Raise vbError, "", "Open assembly document"
+    End If
+
+    GoTo finally_
+
+catch_:
+    MsgBox Err.Description, vbCritical
+finally_:
+
+End Sub
+
+Sub ColorizeComponents(vComps As Variant)
+
+    Dim i As Integer
+
+    Dim processedDocs() As String
+
+    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
+
+            If Not PARTS_ONLY Or swRefModel.GetType() = swDocumentTypes_e.swDocPART Then
+
+                Dim docKey As String
+                docKey = LCase(swRefModel.GetPathName())
+
+                If Not ALL_CONFIGS Then
+                    docKey = docKey & ":" & LCase(swComp.ReferencedConfiguration)
+                End If
+
+                If COMP_LEVEL Or Not Contains(processedDocs, docKey) Then
+
+                    If (Not processedDocs) = -1 Then
+                        ReDim processedDocs(0)
+                    Else
+                        ReDim Preserve processedDocs(UBound(processedDocs) + 1)
+                    End If
+
+                    processedDocs(UBound(processedDocs)) = docKey
+
+                    Dim color As Long
+                    color = RGB(Int(255 * Rnd), Int(255 * Rnd), Int(255 * Rnd))
+
+                    If PRP_NAME <> "" Then
+
+                        Dim prpVal As String
+
+                        prpVal = GetModelPropertyValue(swRefModel, swComp.ReferencedConfiguration, PRP_NAME)
+
+                        If prpVal <> "" Then
+
+                            If ColorsMap.Exists(prpVal) Then
+                                color = ColorsMap(prpVal)
+                            Else
+                                ColorsMap.Add prpVal, color
+                            End If
+
+                        End If
+
+                    End If
+
+                    Dim RGBHex As String
+
+                    RGBHex = Right("000000" & Hex(color), 6)
+
+                    Dim dMatPrps(8) As Double
+
+                    dMatPrps(0) = CInt("&H" & Mid(RGBHex, 5, 2)) / 255
+                    dMatPrps(1) = CInt("&H" & Mid(RGBHex, 3, 2)) / 255
+                    dMatPrps(2) = CInt("&H" & Mid(RGBHex, 1, 2)) / 255
+                    dMatPrps(3) = 1
+                    dMatPrps(4) = 1
+                    dMatPrps(5) = 0.5
+                    dMatPrps(6) = 0.3125
+                    dMatPrps(7) = 0
+                    dMatPrps(8) = 0
+
+                    If COMP_LEVEL Then
+                        swComp.SetMaterialPropertyValues2 dMatPrps, IIf(ALL_CONFIGS, swInConfigurationOpts_e.swAllConfiguration, swInConfigurationOpts_e.swThisConfiguration), Empty
+                    Else
+                        Dim sConfs(0)  As String
+                        sConfs(0) = swComp.ReferencedConfiguration
+                        swRefModel.Extension.SetMaterialPropertyValues dMatPrps, IIf(ALL_CONFIGS, swInConfigurationOpts_e.swAllConfiguration, swInConfigurationOpts_e.swSpecifyConfiguration), IIf(ALL_CONFIGS, Empty, sConfs)
+                    End If
+
+                End If
+
+            End If
+
+        End If
+
+    Next
+
+End Sub
+
+Function GetModelPropertyValue(model As SldWorks.ModelDoc2, confName As String, prpName As String) As String
+
+    Dim prpVal As String
+    Dim swCustPrpMgr As SldWorks.CustomPropertyManager
+
+    Set swCustPrpMgr = model.Extension.CustomPropertyManager(confName)
+    prpVal = GetPropertyValue(swCustPrpMgr, prpName)
+
+    If prpVal = "" Then
+        Set swCustPrpMgr = model.Extension.CustomPropertyManager("")
+        prpVal = GetPropertyValue(swCustPrpMgr, prpName)
+    End If
+
+    GetModelPropertyValue = prpVal
+
+End Function
+
+Function GetPropertyValue(custPrpMgr As SldWorks.CustomPropertyManager, prpName As String) As String
+    Dim resVal As String
+    custPrpMgr.Get2 prpName, "", resVal
+    GetPropertyValue = resVal
+End Function
+
+Function Contains(arr() As String, item As String) As Boolean
+
+    If (Not arr) <> -1 Then
+
+        Dim i As Integer
+
+        For i = 0 To UBound(arr)
+            If arr(i) = item Then
+                Contains = True
+                Exit Function
+            End If
+        Next
+
+    End If
+
+    Contains = False
+
+End Function

solidworks-api/document/appearance/color-assembly/index.md

@@ -0,0 +1,29 @@
+---
+caption: Apply Random Colors To Components
+title: Macro to apply random colors to components in SOLIDWORKS assembly
+description: VBA macro to apply random color to all components in the SOLIDWORKS assembly with an option to apply on a component or model level and group by custom property value
+---
+This VBA macro applies a random color on all components of the active assembly.
+
+Modify constants of the macro to change the level of the color (component or model level).
+
+If colors is applied to the individual configurations (e.g. **ALL_CONFIGS** = **False**), documents must have a display state linked to the configuration, otherwise the color cannot be configuration specific
+
+~~~ vb
+Const COMP_LEVEL As Boolean = True 'True to apply color on the assembly level, False to apply color on a model level
+Const PARTS_ONLY As Boolean = True 'True to only process part components, False to apply color to assemblies as well
+Const ALL_CONFIGS As Boolean = True 'True to apply color to all configurations, False to apply to referenced configuration only
+~~~
+
+~~~ vb
+Const PRP_NAME As String = "Type" 'Custom property to group color by, Empty string "" to not group components
+
+Sub InitColors(Optional dummy As Variant = Empty)
+
+    ColorsMap.Add "Plate", RGB(255, 0, 0) 'Color all component which custom property 'Type' equals to 'Plate' to Red color
+    ColorsMap.Add "Beam", RGB(0, 255, 0) 'Color all component which custom property 'Type' equals to 'Beam' to Green color
+
+End Sub
+~~~
+
+{% code-snippet { file-name: Macro.vba } %}

solidworks-api/document/appearance/remove-color/Macro.vba

@@ -6,23 +6,38 @@ Sub main()
 
     Set swApp = Application.SldWorks
 
-    Dim swPart As SldWorks.PartDoc
+    Dim swModel As SldWorks.ModelDoc2
 
-    Set swPart = GetActivePart(swApp)
+    Set swModel = swApp.ActiveDoc
 
-    If Not swPart Is Nothing Then
+    If Not swModel Is Nothing Then
+
+        If swModel.GetType() = swDocumentTypes_e.swDocDRAWING Then
+            Err.Raise vbError, "", "Drawings are not supported"
+        End If
 
         Dim configOpts As swInConfigurationOpts_e
         configOpts = GetConfigurationOptions(REMOVE_FROM_ALL_CONFIGS)
 
-        Dim vBodies As Variant
-        vBodies = swPart.GetBodies2(swBodyType_e.swAllBodies, False)
+        If swModel.GetType() = swDocumentTypes_e.swDocPART Then
+
+            Dim swPart As SldWorks.PartDoc
+            Set swPart = swModel
+
+            Dim vBodies As Variant
+            vBodies = swPart.GetBodies2(swBodyType_e.swAllBodies, False)
+
+            RemoveMaterialPropertiesFromBodies vBodies, True, configOpts
+            RemoveMaterialPropertiesFromFeatures swPart.FeatureManager.GetFeatures(False), configOpts
+
+        End If
+
+        swModel.Extension.RemoveMaterialProperty configOpts, Empty
 
-        RemoveMaterialPropertiesFromBodies vBodies, True, configOpts
-        RemoveMaterialPropertiesFromFeatures swPart.FeatureManager.GetFeatures(False), configOpts
+        swModel.GraphicsRedraw2
 
     Else
-        MsgBox "Please open part document"
+        Err.Raise "Please open part or assembly document"
     End If
 
 End Sub
@@ -82,27 +97,20 @@ Sub RemoveMaterialPropertiesFromFeatures(features As Variant, configOpts As swIn
             Dim swFeat As SldWorks.Feature
             Set swFeat = features(i)
 
+            Debug.Print swFeat.Name
             swFeat.RemoveMaterialProperty2 configOpts, Empty
 
         Next
 
     End If
 End Sub
 
-Function GetActivePart(app As SldWorks.SldWorks) As SldWorks.PartDoc
-
-    On Error Resume Next
-
-    Set GetActivePart = app.ActiveDoc
-
-End Function
-
 Function GetConfigurationOptions(allConfigs As Boolean) As swInConfigurationOpts_e
 
     If REMOVE_FROM_ALL_CONFIGS Then
-        GetConfigurationOptions = swAllConfiguration
+        GetConfigurationOptions = swInConfigurationOpts_e.swAllConfiguration
     Else
-        GetConfigurationOptions = swThisConfiguration
+        GetConfigurationOptions = swInConfigurationOpts_e.swThisConfiguration
     End If
 
 End Function

solidworks-api/document/appearance/remove-color/index.md

@@ -1,15 +1,15 @@
 ---
 layout: sw-tool
-title: Macro to remove all colors from SOLIDWORKS part
+title: Macro to remove all colors from SOLIDWORKS document
 caption: Remove All Colors From Part
-description: Macro demonstrates how to remove all colors from the part document on all levels (face, feature, body) using SOLIDWORKS API
+description: Macro demonstrates how to remove all colors from the part or assembly documents on all levels (face, feature, body, model) using SOLIDWORKS API
 image: remove-colors.svg
 labels: [remove color, appearance, material property]
 group: Part
 ---
 ![Appearance layers in Part document](material-properties-levels.png){ width=250 }
 
-This macro removes all colors from the part document on all levels (face, feature, body) using SOLIDWORKS API.
+This macro removes all colors from the part document on all levels (face, feature, body, model) using SOLIDWORKS API.
 
 Macro can be configured to remove the colors from all configurations or active configuration only. This option can be set by changing the value of the following constant at the beginning of the macro:
 

solidworks-api/document/drawing/replace-sheet-format/Macro.vba

@@ -123,7 +123,11 @@ Sub ReplaceSheetFormat(draw As SldWorks.DrawingDoc, sheet As SldWorks.sheet, tar
     height = CDbl(vProps(6))
     custPrpView = sheet.CustomPropertyView
 
-    If False = draw.SetupSheet5(sheet.GetName(), paperSize, templateType, scale1, scale2, firstAngle, targetSheetFormatFile, width, height, custPrpView, REMOVE_MODIFIED_NOTES) Then
+    If False <> draw.SetupSheet5(sheet.GetName(), paperSize, templateType, scale1, scale2, firstAngle, targetSheetFormatFile, width, height, custPrpView, REMOVE_MODIFIED_NOTES) Then
+        If sheet.ReloadTemplate(Not REMOVE_MODIFIED_NOTES) <> swReloadTemplateResult_e.swReloadTemplate_Success Then
+            Err.Raise vbError, "", "Failed to reload sheet format"
+        End If
+    Else
         Err.Raise vbError, "", "Failed to set the sheet format"
     End If