Merge branch 'xarial:master' into master

Author: andrMollo

solidworks-api/document/assembly/components/write-quantities/Macro.vba

@@ -198,23 +198,56 @@ Sub WriteBomQuantities(bom() As BomPosition)
         For i = 0 To UBound(bom)
 
             Dim refConfName As String
-        
+            
+            Dim swRefModel As SldWorks.ModelDoc2
+            Set swRefModel = bom(i).model
+            
             If MERGE_CONFIGURATIONS Then
                 refConfName = ""
             Else
                 refConfName = bom(i).Configuration
+                
+                If swRefModel.GetBendState() <> swSMBendState_e.swSMBendStateNone Then
+                
+                    Dim swConf As SldWorks.Configuration
+                    Set swConf = swRefModel.GetConfigurationByName(refConfName)
+                    
+                    Dim vChildConfs As Variant
+                    vChildConfs = swConf.GetChildren()
+                    
+                    If Not IsEmpty(vChildConfs) Then
+                        Dim j As Integer
+                        
+                        For j = 0 To UBound(vChildConfs)
+                            
+                            Dim swChildConf As SldWorks.Configuration
+                            Set swChildConf = vChildConfs(j)
+                            
+                            If swChildConf.Type = swConfigurationType_e.swConfiguration_SheetMetal Then
+                                SetQuantity swRefModel, swChildConf.Name, bom(i).Quantity
+                            End If
+                            
+                        Next
+                        
+                    End If
+                    
+                End If
+                
             End If
 
-            Dim swRefModel As SldWorks.ModelDoc2
-            Set swRefModel = bom(i).model
-            
-            Dim swCustPrpsMgr As SldWorks.CustomPropertyManager
-            Set swCustPrpsMgr = swRefModel.Extension.CustomPropertyManager(refConfName)
-            
-            swCustPrpsMgr.Add3 PRP_NAME, swCustomInfoType_e.swCustomInfoText, bom(i).Quantity, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue
-            swCustPrpsMgr.Set2 PRP_NAME, bom(i).Quantity
+            SetQuantity swRefModel, refConfName, bom(i).Quantity
 
         Next
     End If
 
+End Sub
+
+Sub SetQuantity(model As SldWorks.ModelDoc2, confName As String, qty As Double)
+    
+    Dim swCustPrpsMgr As SldWorks.CustomPropertyManager
+    Set swCustPrpsMgr = model.Extension.CustomPropertyManager(confName)
+    
+    swCustPrpsMgr.Add3 PRP_NAME, swCustomInfoType_e.swCustomInfoText, qty, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue
+    swCustPrpsMgr.Set2 PRP_NAME, qty
+    
 End Sub

solidworks-api/document/sketch/assign-random-color/Macro.vba

@@ -0,0 +1,101 @@
+Const SKIP_ASSIGNED As Boolean = True
+Const UNABSORBED_ONLY As Boolean = True
+
+Dim swApp As SldWorks.SldWorks
+Dim swModel As SldWorks.ModelDoc2
+
+Sub main()
+
+    Set swApp = Application.SldWorks
+
+    Set swModel = swApp.ActiveDoc
+    
+    Dim vFeats As Variant
+    vFeats = CollectAllSketchFeatures(swModel.FirstFeature)
+    
+    If Not IsEmpty(vFeats) Then
+        
+        Dim i As Integer
+        
+        For i = 0 To UBound(vFeats)
+            
+            Dim swFeat As SldWorks.Feature
+            Set swFeat = vFeats(i)
+            
+            If Not SKIP_ASSIGNED Or Not HasAppearence(swFeat) Then
+                
+                If Not UNABSORBED_ONLY Or Not IsAbsorbed(swFeat) Then
+                    
+                    Dim dMatPrps(8) As Double
+                    dMatPrps(0) = Rnd(): dMatPrps(1) = Rnd(): dMatPrps(2) = Rnd()
+                    dMatPrps(3) = 1: dMatPrps(4) = 1: dMatPrps(5) = 0.5
+                    dMatPrps(6) = 0.4: dMatPrps(7) = 0: dMatPrps(8) = 0
+                    
+                    Debug.Print "Assigning color " & dMatPrps(0) * 255 & ";" & dMatPrps(1) * 255 & ";" & dMatPrps(2) * 255 & " to " & swFeat.Name
+                    
+                    swFeat.SetMaterialPropertyValues2 dMatPrps, swInConfigurationOpts_e.swThisConfiguration, Empty
+                    
+                End If
+                
+            End If
+            
+        Next
+        
+    End If
+
+End Sub
+
+Function IsAbsorbed(feat As SldWorks.Feature) As Boolean
+    
+    Dim vFeatChildren As Variant
+    vFeatChildren = feat.GetChildren()
+    
+    IsAbsorbed = Not IsEmpty(vFeatChildren)
+    
+End Function
+
+Function HasAppearence(feat As SldWorks.Feature) As Boolean
+    
+    Dim vMatPrpVals As Variant
+    vMatPrpVals = feat.GetMaterialPropertyValues2(swInConfigurationOpts_e.swThisConfiguration, Empty)
+            
+    HasAppearence = vMatPrpVals(0) <> -1 And vMatPrpVals(1) <> -1 And vMatPrpVals(2) <> -1
+    
+End Function
+
+Function CollectAllSketchFeatures(firstFeat As SldWorks.Feature) As Variant
+    
+    Const SKETCH_FEAT_TYPE_NAME As String = "ProfileFeature"
+    Const SKETCH_3D_FEAT_TYPE_NAME As String = "3DProfileFeature"
+
+    Dim swFeats() As SldWorks.Feature
+
+    Dim swFeat As SldWorks.Feature
+    Set swFeat = firstFeat
+    
+    While Not swFeat Is Nothing
+    
+        If swFeat.GetTypeName2 = SKETCH_FEAT_TYPE_NAME Or _
+            swFeat.GetTypeName2 = SKETCH_3D_FEAT_TYPE_NAME Then
+            
+            If (Not swFeats) = -1 Then
+                ReDim swFeats(0)
+            Else
+                ReDim Preserve swFeats(UBound(swFeats) + 1)
+            End If
+            
+            Set swFeats(UBound(swFeats)) = swFeat
+            
+        End If
+        
+        Set swFeat = swFeat.GetNextFeature
+        
+    Wend
+    
+    If (Not swFeats) = -1 Then
+        CollectAllSketchFeatures = Empty
+    Else
+        CollectAllSketchFeatures = swFeats
+    End If
+    
+End Function

solidworks-api/document/sketch/assign-random-color/index.md

@@ -0,0 +1,16 @@
+---
+caption: Assign Random Color To Sketches
+title: Macro to assign random color to sketches in the document
+description: VBA macro assigns random color to sketches in SOLIDWORKS parts or assemblies with an option to skip already assigned sketches and unabsorbed sketches
+---
+
+This VBA macro assigns the random color to all sketches of active parts or assemblies.
+
+Macro can be configured to skip sketches with already assigned colors and select only unabsorbed sketches (e.g. sketches which are not used in other features)
+
+~~~vb
+Const SKIP_ASSIGNED As Boolean = False 'Processes all sketches (including the sketches with assigned colors)
+Const UNABSORBED_ONLY As Boolean = False 'Process all sketches (absorbed and unabsorbed)
+~~~
+
+{% code-snippet { file-name: Macro.vba } %}