Skip to content

Commit c0f9d20

Browse files
committed
Added Rename views after sheets macro
Added batch create folders macro Added split folders to configs macro Added save drawing with detailing mode on and off
1 parent 090e68e commit c0f9d20

File tree

9 files changed

+325
-2
lines changed

9 files changed

+325
-2
lines changed

solidworks-api/document/drawing/open-referenced-model/index.md

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
---
22
layout: sw-tool
3-
title: Open Drawing View Referenced Document
4-
caption: VBA macro to open referenced document of the drawing view
3+
title: VBA macro to open referenced document of the drawing view
4+
caption: Open Drawing View Referenced Document
55
description: VBA macro opens the document referenced by the selected drawing view in the referenced configuration and display state
66
image: ref-doc-display-state.svg
77
labels: [drawing,reference,display state]
Lines changed: 69 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,69 @@
1+
Dim swApp As SldWorks.SldWorks
2+
3+
Sub main()
4+
5+
Set swApp = Application.SldWorks
6+
7+
Dim swModel As SldWorks.ModelDoc2
8+
9+
Set swModel = swApp.ActiveDoc
10+
11+
If Not swModel Is Nothing Then
12+
13+
If swModel.GetType() = swDocumentTypes_e.swDocDRAWING Then
14+
15+
Dim swDraw As SldWorks.DrawingDoc
16+
17+
Set swDraw = swModel
18+
19+
Dim vSheets As Variant
20+
vSheets = swDraw.GetViews
21+
22+
Dim i As Integer
23+
24+
For i = 0 To UBound(vSheets)
25+
26+
Dim vViews As Variant
27+
vViews = vSheets(i)
28+
29+
Dim swSheetView As SldWorks.View
30+
31+
Set swSheetView = vViews(0)
32+
33+
Dim j As Integer
34+
35+
Dim nextViewIndex As Integer
36+
nextViewIndex = 0
37+
38+
For j = 1 To UBound(vViews)
39+
40+
Dim swView As SldWorks.View
41+
Set swView = vViews(j)
42+
43+
Dim viewType As Integer
44+
viewType = swView.Type
45+
46+
If viewType <> swDrawingViewTypes_e.swDrawingDetailView And viewType <> swDrawingViewTypes_e.swDrawingSectionView Then
47+
48+
nextViewIndex = nextViewIndex + 1
49+
50+
Dim newViewName As String
51+
newViewName = swSheetView.Name & nextViewIndex
52+
53+
If False = swView.SetName2(newViewName) Then
54+
Err.Raise vbError, "", "Failed to rename " & swView.Name & " to " & ""
55+
End If
56+
End If
57+
58+
Next
59+
60+
Next
61+
62+
Else
63+
Err.Raise vbError, "", "Active document is not a drawing"
64+
End If
65+
Else
66+
Err.Raise vbError, "", "Please open the drawing"
67+
End If
68+
69+
End Sub
Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
---
2+
caption: Rename Drawings Views After Sheets
3+
title: Macro to rename all drawing views after the sheet name
4+
description: VBA macro renames all SOLIDWORKS drawings views after the sheet name the drawing view is on
5+
---
6+
This VBA macro allows to rename all drawing views from all sheets in the active SOLIDWORKS drawing document after the sheet name followed by index.
7+
8+
Detailing and section views will be excluded from the renaming process.
9+
10+
{% code-snippet { file-name: Macro.vba } %}
Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
Dim swApp As SldWorks.SldWorks
2+
3+
Sub main()
4+
5+
Set swApp = Application.SldWorks
6+
7+
Dim swModel As SldWorks.ModelDoc2
8+
9+
Set swModel = swApp.ActiveDoc
10+
11+
If Not swModel Is Nothing Then
12+
13+
Dim foldersCount As Integer
14+
Dim folderNamePrefix As String
15+
16+
foldersCount = CInt(InputBox("Specify the number of folders to create", "Batch Folder Creator", "5"))
17+
folderNamePrefix = InputBox("Specify the prefix name of the folder", "Batch Folder Creator", "MyFolder")
18+
19+
Dim swAnchorFeat As SldWorks.Feature
20+
Set swAnchorFeat = swModel.Extension.GetLastFeatureAdded
21+
22+
Dim swFeatMgr As SldWorks.FeatureManager
23+
Set swFeatMgr = swModel.FeatureManager
24+
25+
Dim i As Integer
26+
27+
Dim nextIndex As Integer
28+
nextIndex = 0
29+
30+
For i = 1 To foldersCount
31+
32+
swAnchorFeat.Select2 False, -1
33+
34+
Dim swFolderFeat As SldWorks.Feature
35+
Set swFolderFeat = swFeatMgr.InsertFeatureTreeFolder2(swFeatureTreeFolderType_e.swFeatureTreeFolder_EmptyBefore)
36+
37+
If swFolderFeat Is Nothing Then
38+
Err.Raise vbError, "", "Failed to create a folder, make sure there there is at least one feature in the model"
39+
End If
40+
41+
Dim folderName As String
42+
43+
Do
44+
nextIndex = nextIndex + 1
45+
folderName = folderNamePrefix & nextIndex
46+
Loop While False <> swFeatMgr.IsNameUsed(swNameType_e.swFeatureName, folderName)
47+
48+
swFolderFeat.Name = folderName
49+
50+
swModel.Extension.ReorderFeature swFolderFeat.Name, "", swMoveLocation_e.swMoveToEnd
51+
52+
Next
53+
54+
Else
55+
Err.Raise vbError, "", "No model opened"
56+
End If
57+
58+
End Sub
Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
---
2+
caption: Batch Create Folders
3+
title: Batch create feature folders in the active SOLIDWORKS document
4+
description: VBA macro creates specified number of the feature folders with the specified prefix name in the active SOLIDWORKS part or assembly
5+
---
6+
This VBA macro allows to create feature folders in the batch mode in the active SOLIDWORKS assembly or part document.
7+
8+
Macro will ask for the number of folders to be created and the folder prefix name.
9+
10+
Macro will create the specified number of folder with the prefix name followed by the index.
11+
12+
> If folder with the next index already exists, next index will be used for the naming
13+
14+
{% code-snippet { file-name: Macro.vba } %}
Lines changed: 102 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,102 @@
1+
Const FOLDER_END_TAG As String = "___EndTag___"
2+
3+
Dim swApp As SldWorks.SldWorks
4+
5+
Sub main()
6+
7+
Set swApp = Application.SldWorks
8+
9+
Dim swModel As SldWorks.ModelDoc2
10+
11+
Set swModel = swApp.ActiveDoc
12+
13+
If Not swModel Is Nothing Then
14+
15+
Dim vFeatFolders As Variant
16+
vFeatFolders = GetAllFeatureFolders(swModel)
17+
18+
If Not IsEmpty(vFeatFolders) Then
19+
20+
Dim activeConfName As String
21+
activeConfName = swModel.ConfigurationManager.ActiveConfiguration.Name
22+
23+
Dim i As Integer
24+
25+
For i = 0 To UBound(vFeatFolders)
26+
Dim swFeatFolder As SldWorks.Feature
27+
Set swFeatFolder = vFeatFolders(i)
28+
CreateConfigurationForFolder swModel, swFeatFolder, vFeatFolders, activeConfName
29+
Next
30+
31+
End If
32+
33+
Else
34+
Err.Raise vbError, "", "No active document"
35+
End If
36+
37+
End Sub
38+
39+
Function GetAllFeatureFolders(model As SldWorks.ModelDoc2) As Variant
40+
41+
Dim swFeatFolders() As SldWorks.Feature
42+
43+
Dim swFeat As SldWorks.Feature
44+
Set swFeat = model.FirstFeature
45+
46+
While Not swFeat Is Nothing
47+
48+
If swFeat.GetTypeName2() = "FtrFolder" And LCase(Right(swFeat.Name, Len(FOLDER_END_TAG))) <> LCase(FOLDER_END_TAG) Then
49+
50+
If (Not swFeatFolders) = -1 Then
51+
ReDim swFeatFolders(0)
52+
Else
53+
ReDim Preserve swFeatFolders(UBound(swFeatFolders) + 1)
54+
End If
55+
56+
Set swFeatFolders(UBound(swFeatFolders)) = swFeat
57+
58+
End If
59+
60+
Set swFeat = swFeat.GetNextFeature
61+
62+
Wend
63+
64+
65+
If (Not swFeatFolders) = -1 Then
66+
GetAllFeatureFolders = Empty
67+
Else
68+
GetAllFeatureFolders = swFeatFolders
69+
End If
70+
71+
End Function
72+
73+
Sub CreateConfigurationForFolder(model As SldWorks.ModelDoc2, folderFeat As SldWorks.Feature, allFeatFolders As Variant, parentConfName As String)
74+
75+
Dim swFolderConf As SldWorks.Configuration
76+
Set swFolderConf = model.ConfigurationManager.AddConfiguration2(folderFeat.Name, "", "", swConfigurationOptions2_e.swConfigOption_DontActivate Or swConfigurationOptions2_e.swConfigOption_SuppressByDefault, parentConfName, "", False)
77+
78+
If swFolderConf Is Nothing Then
79+
Err.Raise vbError, "", "Failed to create configuration for " & folderFeat.Name
80+
End If
81+
82+
Dim i As Integer
83+
84+
For i = 0 To UBound(allFeatFolders)
85+
86+
Dim swOtherFeatFolder As SldWorks.Feature
87+
Set swOtherFeatFolder = allFeatFolders(i)
88+
89+
If swApp.IsSame(folderFeat, swOtherFeatFolder) <> swObjectEquality.swObjectSame Then
90+
91+
Dim targetConf(0) As String
92+
targetConf(0) = swFolderConf.Name
93+
94+
If False = swOtherFeatFolder.SetSuppression2(swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swSpecifyConfiguration, targetConf) Then
95+
Err.Raise vbError, "", "Failed to configure the suppression of the folder feature for " & swOtherFeatFolder.Name & " in " & swFolderConf.Name
96+
End If
97+
98+
End If
99+
100+
Next
101+
102+
End Sub
Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
---
2+
caption: Split Folders To Configurations
3+
title: Split feature folders of the SOLIDWORKS file to individual configurations
4+
description: VBA macro creates individual configurations for each feature folder in the active SOLIDWORKS part or assembly
5+
---
6+
This VBA macro creates configuration for each top-level feature folder in the active SOLIDWORKS part or assembly.
7+
8+
Derived configuration will be created for each feature folder and will be named after it.
9+
10+
All other folders will be suppressed for each configuration. Features outside of the folders will not be suppressed.
11+
12+
{% code-snippet { file-name: Macro.vba } %}
Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
Const ENABLE As Boolean = True
2+
3+
Const swCommands_Save As Long = 2
4+
5+
Dim swApp As SldWorks.SldWorks
6+
7+
Sub main()
8+
9+
Set swApp = Application.SldWorks
10+
11+
Dim swModel As SldWorks.ModelDoc2
12+
13+
Set swModel = swApp.ActiveDoc
14+
15+
If Not swModel Is Nothing Then
16+
17+
If swModel.GetType() = swDocumentTypes_e.swDocDRAWING Then
18+
Dim saveModelDataOpt As Boolean
19+
Dim includeStandardView As Boolean
20+
21+
saveModelDataOpt = swModel.Extension.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingModeSaveModelData, swUserPreferenceOption_e.swDetailingNoOptionSpecified)
22+
includeStandardView = swModel.Extension.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingModeIncludeStandardViewsInViewPalette, swUserPreferenceOption_e.swDetailingNoOptionSpecified)
23+
24+
swModel.Extension.SetUserPreferenceToggle swUserPreferenceToggle_e.swDetailingModeSaveModelData, swUserPreferenceOption_e.swDetailingNoOptionSpecified, ENABLE
25+
swModel.Extension.SetUserPreferenceToggle swUserPreferenceToggle_e.swDetailingModeIncludeStandardViewsInViewPalette, swUserPreferenceOption_e.swDetailingNoOptionSpecified, ENABLE
26+
27+
swApp.RunCommand swCommands_Save, ""
28+
29+
swModel.Extension.SetUserPreferenceToggle swUserPreferenceToggle_e.swDetailingModeSaveModelData, swUserPreferenceOption_e.swDetailingNoOptionSpecified, saveModelDataOpt
30+
swModel.Extension.SetUserPreferenceToggle swUserPreferenceToggle_e.swDetailingModeIncludeStandardViewsInViewPalette, swUserPreferenceOption_e.swDetailingNoOptionSpecified, includeStandardView
31+
Else
32+
Err.Raise vbError, "", "Only drawing documents are supported"
33+
End If
34+
Else
35+
Err.Raise vbError, "", "Open drawing document"
36+
End If
37+
38+
End Sub
Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
---
2+
caption: Toggle Drawing Detailing Mode On Save
3+
title: Save SOLIDWORKS drawing with detailing mode on and off
4+
description: VBA Macro to toggle detailing mode on and off while saving
5+
---
6+
When working with large drawings it may be beneficial to employ the detailing mode. In order to properly utilize the detailing mode it is required to save the data within the document itself.
7+
8+
This process may decrease the saving performance.
9+
10+
The toggle option to enable or disable saving of the detailing mode data is driven by document preferences.
11+
12+
This macro allows to turn on or off the settings and perform the saving of the document.
13+
14+
~~~ vb
15+
Const ENABLE As Boolean = True 'True to save with detailing data, False to save without the detailing data
16+
~~~
17+
18+
It is possible to create 2 macro buttons (one which saves with detailing data and one which saves without the detailing data).
19+
20+
{% code-snippet { file-name: Macro.vba } %}

0 commit comments

Comments
 (0)