Skip to content

Commit a79e4be

Browse files
andrMolloandrMollo
authored
Merge pull request #5 from xarial/master
Merge from master
2 parents ec95260 + cac4262 commit a79e4be

File tree

7 files changed

+398
-23
lines changed

7 files changed

+398
-23
lines changed

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

Lines changed: 196 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,196 @@
1+
Const COMP_LEVEL As Boolean = True
2+
Const PARTS_ONLY As Boolean = True
3+
Const ALL_CONFIGS As Boolean = True
4+
Const PRP_NAME As String = ""
5+
6+
Dim swApp As SldWorks.SldWorks
7+
Dim ColorsMap As Object
8+
9+
Sub InitColors(Optional dummy As Variant = Empty)
10+
11+
ColorsMap.Add "Plate", RGB(255, 0, 0)
12+
ColorsMap.Add "Beam", RGB(0, 255, 0)
13+
14+
End Sub
15+
16+
Sub main()
17+
18+
try_:
19+
20+
On Error GoTo catch_
21+
22+
Set ColorsMap = CreateObject("Scripting.Dictionary")
23+
24+
ColorsMap.CompareMode = vbTextCompare
25+
26+
InitColors
27+
28+
Set swApp = Application.SldWorks
29+
30+
Dim swModel As SldWorks.ModelDoc2
31+
32+
Set swModel = swApp.ActiveDoc
33+
34+
If Not swModel Is Nothing Then
35+
36+
If swModel.GetType() = swDocumentTypes_e.swDocASSEMBLY Then
37+
38+
Dim swAssy As SldWorks.AssemblyDoc
39+
40+
Set swAssy = swModel
41+
42+
swAssy.ResolveAllLightWeightComponents True
43+
44+
Dim vComps As Variant
45+
vComps = swAssy.GetComponents(False)
46+
47+
ColorizeComponents vComps
48+
49+
swModel.GraphicsRedraw2
50+
Else
51+
Err.Raise vbError, "", "Only assembly document is supported"
52+
End If
53+
Else
54+
Err.Raise vbError, "", "Open assembly document"
55+
End If
56+
57+
GoTo finally_
58+
59+
catch_:
60+
MsgBox Err.Description, vbCritical
61+
finally_:
62+
63+
End Sub
64+
65+
Sub ColorizeComponents(vComps As Variant)
66+
67+
Dim i As Integer
68+
69+
Dim processedDocs() As String
70+
71+
For i = 0 To UBound(vComps)
72+
73+
Dim swComp As SldWorks.Component2
74+
Set swComp = vComps(i)
75+
76+
Dim swRefModel As SldWorks.ModelDoc2
77+
78+
Set swRefModel = swComp.GetModelDoc2()
79+
80+
If Not swRefModel Is Nothing Then
81+
82+
If Not PARTS_ONLY Or swRefModel.GetType() = swDocumentTypes_e.swDocPART Then
83+
84+
Dim docKey As String
85+
docKey = LCase(swRefModel.GetPathName())
86+
87+
If Not ALL_CONFIGS Then
88+
docKey = docKey & ":" & LCase(swComp.ReferencedConfiguration)
89+
End If
90+
91+
If COMP_LEVEL Or Not Contains(processedDocs, docKey) Then
92+
93+
If (Not processedDocs) = -1 Then
94+
ReDim processedDocs(0)
95+
Else
96+
ReDim Preserve processedDocs(UBound(processedDocs) + 1)
97+
End If
98+
99+
processedDocs(UBound(processedDocs)) = docKey
100+
101+
Dim color As Long
102+
color = RGB(Int(255 * Rnd), Int(255 * Rnd), Int(255 * Rnd))
103+
104+
If PRP_NAME <> "" Then
105+
106+
Dim prpVal As String
107+
108+
prpVal = GetModelPropertyValue(swRefModel, swComp.ReferencedConfiguration, PRP_NAME)
109+
110+
If prpVal <> "" Then
111+
112+
If ColorsMap.Exists(prpVal) Then
113+
color = ColorsMap(prpVal)
114+
Else
115+
ColorsMap.Add prpVal, color
116+
End If
117+
118+
End If
119+
120+
End If
121+
122+
Dim RGBHex As String
123+
124+
RGBHex = Right("000000" & Hex(color), 6)
125+
126+
Dim dMatPrps(8) As Double
127+
128+
dMatPrps(0) = CInt("&H" & Mid(RGBHex, 5, 2)) / 255
129+
dMatPrps(1) = CInt("&H" & Mid(RGBHex, 3, 2)) / 255
130+
dMatPrps(2) = CInt("&H" & Mid(RGBHex, 1, 2)) / 255
131+
dMatPrps(3) = 1
132+
dMatPrps(4) = 1
133+
dMatPrps(5) = 0.5
134+
dMatPrps(6) = 0.3125
135+
dMatPrps(7) = 0
136+
dMatPrps(8) = 0
137+
138+
If COMP_LEVEL Then
139+
swComp.SetMaterialPropertyValues2 dMatPrps, IIf(ALL_CONFIGS, swInConfigurationOpts_e.swAllConfiguration, swInConfigurationOpts_e.swThisConfiguration), Empty
140+
Else
141+
Dim sConfs(0) As String
142+
sConfs(0) = swComp.ReferencedConfiguration
143+
swRefModel.Extension.SetMaterialPropertyValues dMatPrps, IIf(ALL_CONFIGS, swInConfigurationOpts_e.swAllConfiguration, swInConfigurationOpts_e.swSpecifyConfiguration), IIf(ALL_CONFIGS, Empty, sConfs)
144+
End If
145+
146+
End If
147+
148+
End If
149+
150+
End If
151+
152+
Next
153+
154+
End Sub
155+
156+
Function GetModelPropertyValue(model As SldWorks.ModelDoc2, confName As String, prpName As String) As String
157+
158+
Dim prpVal As String
159+
Dim swCustPrpMgr As SldWorks.CustomPropertyManager
160+
161+
Set swCustPrpMgr = model.Extension.CustomPropertyManager(confName)
162+
prpVal = GetPropertyValue(swCustPrpMgr, prpName)
163+
164+
If prpVal = "" Then
165+
Set swCustPrpMgr = model.Extension.CustomPropertyManager("")
166+
prpVal = GetPropertyValue(swCustPrpMgr, prpName)
167+
End If
168+
169+
GetModelPropertyValue = prpVal
170+
171+
End Function
172+
173+
Function GetPropertyValue(custPrpMgr As SldWorks.CustomPropertyManager, prpName As String) As String
174+
Dim resVal As String
175+
custPrpMgr.Get2 prpName, "", resVal
176+
GetPropertyValue = resVal
177+
End Function
178+
179+
Function Contains(arr() As String, item As String) As Boolean
180+
181+
If (Not arr) <> -1 Then
182+
183+
Dim i As Integer
184+
185+
For i = 0 To UBound(arr)
186+
If arr(i) = item Then
187+
Contains = True
188+
Exit Function
189+
End If
190+
Next
191+
192+
End If
193+
194+
Contains = False
195+
196+
End Function

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

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
---
2+
caption: Apply Random Colors To Components
3+
title: Macro to apply random colors to components in SOLIDWORKS assembly
4+
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
5+
---
6+
This VBA macro applies a random color on all components of the active assembly.
7+
8+
Modify constants of the macro to change the level of the color (component or model level).
9+
10+
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
11+
12+
~~~ vb
13+
Const COMP_LEVEL As Boolean = True 'True to apply color on the assembly level, False to apply color on a model level
14+
Const PARTS_ONLY As Boolean = True 'True to only process part components, False to apply color to assemblies as well
15+
Const ALL_CONFIGS As Boolean = True 'True to apply color to all configurations, False to apply to referenced configuration only
16+
~~~
17+
18+
~~~ vb
19+
Const PRP_NAME As String = "Type" 'Custom property to group color by, Empty string "" to not group components
20+
21+
Sub InitColors(Optional dummy As Variant = Empty)
22+
23+
ColorsMap.Add "Plate", RGB(255, 0, 0) 'Color all component which custom property 'Type' equals to 'Plate' to Red color
24+
ColorsMap.Add "Beam", RGB(0, 255, 0) 'Color all component which custom property 'Type' equals to 'Beam' to Green color
25+
26+
End Sub
27+
~~~
28+
29+
{% code-snippet { file-name: Macro.vba } %}

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

Lines changed: 26 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -6,23 +6,38 @@ Sub main()
66

77
Set swApp = Application.SldWorks
88

9-
Dim swPart As SldWorks.PartDoc
9+
Dim swModel As SldWorks.ModelDoc2
1010

11-
Set swPart = GetActivePart(swApp)
11+
Set swModel = swApp.ActiveDoc
1212

13-
If Not swPart Is Nothing Then
13+
If Not swModel Is Nothing Then
14+
15+
If swModel.GetType() = swDocumentTypes_e.swDocDRAWING Then
16+
Err.Raise vbError, "", "Drawings are not supported"
17+
End If
1418

1519
Dim configOpts As swInConfigurationOpts_e
1620
configOpts = GetConfigurationOptions(REMOVE_FROM_ALL_CONFIGS)
1721

18-
Dim vBodies As Variant
19-
vBodies = swPart.GetBodies2(swBodyType_e.swAllBodies, False)
22+
If swModel.GetType() = swDocumentTypes_e.swDocPART Then
23+
24+
Dim swPart As SldWorks.PartDoc
25+
Set swPart = swModel
26+
27+
Dim vBodies As Variant
28+
vBodies = swPart.GetBodies2(swBodyType_e.swAllBodies, False)
29+
30+
RemoveMaterialPropertiesFromBodies vBodies, True, configOpts
31+
RemoveMaterialPropertiesFromFeatures swPart.FeatureManager.GetFeatures(False), configOpts
32+
33+
End If
34+
35+
swModel.Extension.RemoveMaterialProperty configOpts, Empty
2036

21-
RemoveMaterialPropertiesFromBodies vBodies, True, configOpts
22-
RemoveMaterialPropertiesFromFeatures swPart.FeatureManager.GetFeatures(False), configOpts
37+
swModel.GraphicsRedraw2
2338

2439
Else
25-
MsgBox "Please open part document"
40+
Err.Raise "Please open part or assembly document"
2641
End If
2742

2843
End Sub
@@ -82,27 +97,20 @@ Sub RemoveMaterialPropertiesFromFeatures(features As Variant, configOpts As swIn
8297
Dim swFeat As SldWorks.Feature
8398
Set swFeat = features(i)
8499

100+
Debug.Print swFeat.Name
85101
swFeat.RemoveMaterialProperty2 configOpts, Empty
86102

87103
Next
88104

89105
End If
90106
End Sub
91107

92-
Function GetActivePart(app As SldWorks.SldWorks) As SldWorks.PartDoc
93-
94-
On Error Resume Next
95-
96-
Set GetActivePart = app.ActiveDoc
97-
98-
End Function
99-
100108
Function GetConfigurationOptions(allConfigs As Boolean) As swInConfigurationOpts_e
101109

102110
If REMOVE_FROM_ALL_CONFIGS Then
103-
GetConfigurationOptions = swAllConfiguration
111+
GetConfigurationOptions = swInConfigurationOpts_e.swAllConfiguration
104112
Else
105-
GetConfigurationOptions = swThisConfiguration
113+
GetConfigurationOptions = swInConfigurationOpts_e.swThisConfiguration
106114
End If
107115

108116
End Function

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,15 @@
11
---
22
layout: sw-tool
3-
title: Macro to remove all colors from SOLIDWORKS part
3+
title: Macro to remove all colors from SOLIDWORKS document
44
caption: Remove All Colors From Part
5-
description: Macro demonstrates how to remove all colors from the part document on all levels (face, feature, body) using SOLIDWORKS API
5+
description: Macro demonstrates how to remove all colors from the part or assembly documents on all levels (face, feature, body, model) using SOLIDWORKS API
66
image: remove-colors.svg
77
labels: [remove color, appearance, material property]
88
group: Part
99
---
1010
![Appearance layers in Part document](material-properties-levels.png){ width=250 }
1111

12-
This macro removes all colors from the part document on all levels (face, feature, body) using SOLIDWORKS API.
12+
This macro removes all colors from the part document on all levels (face, feature, body, model) using SOLIDWORKS API.
1313

1414
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:
1515

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

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -123,7 +123,11 @@ Sub ReplaceSheetFormat(draw As SldWorks.DrawingDoc, sheet As SldWorks.sheet, tar
123123
height = CDbl(vProps(6))
124124
custPrpView = sheet.CustomPropertyView
125125

126-
If False = draw.SetupSheet5(sheet.GetName(), paperSize, templateType, scale1, scale2, firstAngle, targetSheetFormatFile, width, height, custPrpView, REMOVE_MODIFIED_NOTES) Then
126+
If False <> draw.SetupSheet5(sheet.GetName(), paperSize, templateType, scale1, scale2, firstAngle, targetSheetFormatFile, width, height, custPrpView, REMOVE_MODIFIED_NOTES) Then
127+
If sheet.ReloadTemplate(Not REMOVE_MODIFIED_NOTES) <> swReloadTemplateResult_e.swReloadTemplate_Success Then
128+
Err.Raise vbError, "", "Failed to reload sheet format"
129+
End If
130+
Else
127131
Err.Raise vbError, "", "Failed to set the sheet format"
128132
End If
129133

0 commit comments

Comments
 (0)