Skip to content

Commit e537ffd

Browse files
andrMolloandrMollo
authored
Merge pull request #1 from xarial/master
Update from original repo
2 parents 090e68e + d38e92c commit e537ffd

File tree

9 files changed

+381
-2
lines changed

9 files changed

+381
-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]

‎solidworks-api/document/drawing/rename-views-after-sheets/Macro.vba‎

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

‎solidworks-api/document/drawing/rename-views-after-sheets/index.md‎

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 } %}

‎solidworks-api/document/features-manager/batch-create-folders/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

‎solidworks-api/document/features-manager/batch-create-folders/index.md‎

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 } %}

‎solidworks-api/document/features-manager/split-folders-confgurations/Macro.vba‎

Lines changed: 150 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,150 @@
1+
Const CREATE_DERIVED_CONFS As Boolean = True
2+
3+
Const FOLDER_END_TAG As String = "___EndTag___"
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+
Dim vFeatFolders As Variant
18+
Dim vAllFeatFolders As Variant
19+
20+
Dim swSelMgr As SldWorks.SelectionMgr
21+
Set swSelMgr = swModel.SelectionManager
22+
23+
vAllFeatFolders = GetAllFeatureFolders(swModel)
24+
25+
If swSelMgr.GetSelectedObjectCount2(-1) = 0 Then
26+
vFeatFolders = vAllFeatFolders
27+
Else
28+
vFeatFolders = GetSelectedFeatureFolders(swModel)
29+
End If
30+
31+
If Not IsEmpty(vFeatFolders) Then
32+
33+
Dim activeConfName As String
34+
activeConfName = swModel.ConfigurationManager.ActiveConfiguration.Name
35+
36+
Dim i As Integer
37+
38+
For i = 0 To UBound(vFeatFolders)
39+
Dim swFeatFolder As SldWorks.Feature
40+
Set swFeatFolder = vFeatFolders(i)
41+
CreateConfigurationForFolder swModel, swFeatFolder, vAllFeatFolders, IIf(CREATE_DERIVED_CONFS, activeConfName, "")
42+
Next
43+
44+
End If
45+
46+
Else
47+
Err.Raise vbError, "", "No active document"
48+
End If
49+
50+
End Sub
51+
52+
Function GetAllFeatureFolders(model As SldWorks.ModelDoc2) As Variant
53+
54+
Dim swFeatFolders() As SldWorks.Feature
55+
56+
Dim swFeat As SldWorks.Feature
57+
Set swFeat = model.FirstFeature
58+
59+
While Not swFeat Is Nothing
60+
61+
If swFeat.GetTypeName2() = "FtrFolder" And InStr(LCase(swFeat.Name), LCase(FOLDER_END_TAG)) = 0 Then
62+
63+
If (Not swFeatFolders) = -1 Then
64+
ReDim swFeatFolders(0)
65+
Else
66+
ReDim Preserve swFeatFolders(UBound(swFeatFolders) + 1)
67+
End If
68+
69+
Set swFeatFolders(UBound(swFeatFolders)) = swFeat
70+
71+
End If
72+
73+
Set swFeat = swFeat.GetNextFeature
74+
75+
Wend
76+
77+
78+
If (Not swFeatFolders) = -1 Then
79+
GetAllFeatureFolders = Empty
80+
Else
81+
GetAllFeatureFolders = swFeatFolders
82+
End If
83+
84+
End Function
85+
86+
Function GetSelectedFeatureFolders(model As SldWorks.ModelDoc2) As Variant
87+
88+
Dim swSelMgr As SldWorks.SelectionMgr
89+
Set swSelMgr = model.SelectionManager
90+
91+
Dim swFeatFolders() As SldWorks.Feature
92+
93+
Dim i As Integer
94+
95+
For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
96+
97+
If swSelMgr.GetSelectedObjectType3(i, -1) = swSelectType_e.swSelFTRFOLDER Then
98+
99+
Dim swFeat As SldWorks.Feature
100+
Set swFeat = swSelMgr.GetSelectedObject6(i, -1)
101+
102+
If (Not swFeatFolders) = -1 Then
103+
ReDim swFeatFolders(0)
104+
Else
105+
ReDim Preserve swFeatFolders(UBound(swFeatFolders) + 1)
106+
End If
107+
108+
Set swFeatFolders(UBound(swFeatFolders)) = swFeat
109+
End If
110+
111+
Next
112+
113+
If (Not swFeatFolders) = -1 Then
114+
GetSelectedFeatureFolders = Empty
115+
Else
116+
GetSelectedFeatureFolders = swFeatFolders
117+
End If
118+
119+
End Function
120+
121+
Sub CreateConfigurationForFolder(model As SldWorks.ModelDoc2, folderFeat As SldWorks.Feature, allFeatFolders As Variant, parentConfName As String)
122+
123+
Dim swFolderConf As SldWorks.Configuration
124+
Set swFolderConf = model.ConfigurationManager.AddConfiguration2(folderFeat.Name, "", "", swConfigurationOptions2_e.swConfigOption_DontActivate Or swConfigurationOptions2_e.swConfigOption_SuppressByDefault, parentConfName, "", False)
125+
126+
If swFolderConf Is Nothing Then
127+
Err.Raise vbError, "", "Failed to create configuration for " & folderFeat.Name
128+
End If
129+
130+
Dim i As Integer
131+
132+
For i = 0 To UBound(allFeatFolders)
133+
134+
Dim swOtherFeatFolder As SldWorks.Feature
135+
Set swOtherFeatFolder = allFeatFolders(i)
136+
137+
If swApp.IsSame(folderFeat, swOtherFeatFolder) <> swObjectEquality.swObjectSame Then
138+
139+
Dim targetConf(0) As String
140+
targetConf(0) = swFolderConf.Name
141+
142+
If False = swOtherFeatFolder.SetSuppression2(swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swSpecifyConfiguration, targetConf) Then
143+
Err.Raise vbError, "", "Failed to configure the suppression of the folder feature for " & swOtherFeatFolder.Name & " in " & swFolderConf.Name
144+
End If
145+
146+
End If
147+
148+
Next
149+
150+
End Sub

‎solidworks-api/document/features-manager/split-folders-confgurations/index.md‎

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
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+
If no objects selected in the model then all folder features will be processed, otherwise only selected feature folders will be processed.
9+
10+
Created configuration will be named after the feature folder.
11+
12+
It is possible to specify if derived or top level configurations should be created for each feature folder.
13+
14+
~~~ vb
15+
Const CREATE_DERIVED_CONFS As Boolean = True 'True to create derived configuration, False to create top level configuration
16+
~~~
17+
18+
All other folders will be suppressed for each configuration. Features outside of the folders will not be suppressed.
19+
20+
{% code-snippet { file-name: Macro.vba } %}

‎solidworks-api/options/document/detailing-mode-save-model-data/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

0 commit comments

Comments
 (0)