diff --git a/docs/index.json b/docs/index.json index d300f14..489b69a 100644 --- a/docs/index.json +++ b/docs/index.json @@ -24,6 +24,11 @@ "title": "Export Sheets to PDF Automatically | 🧩 SOLIDWORKS VBA Macros Library", "keywords": "Export Sheets to PDF Automatically Description This VBA macro automates the process of exporting all sheets in a SOLIDWORKS drawing to individual PDF files. The macro loops through all the sheets in the active drawing and exports each one as a PDFs into the folder that the drawing file is in. System Requirements SOLIDWORKS Version: SOLIDWORKS 2018 or later VBA Environment: Pre-installed with SOLIDWORKS (Access via Tools > Macro > New or Edit) Operating System: Windows 7, 8, 10, or later VBA Code: Option Explicit ' DISCLAIMER: ' This macro is provided \"as is\" without any warranty. Blue Byte Systems Inc. is not liable for any issues that arise ' from its use. Always test the macro in a safe environment before applying it to production data. Dim swApp As SldWorks.SldWorks Sub ExportSheetsToPDF() ' Set the SOLIDWORKS application object Set swApp = Application.SldWorks ' Check if SOLIDWORKS is running If swApp Is Nothing Then MsgBox \"Error Connecting to SOLIDWORKS. Please Try Again.\", vbCritical Exit Sub End If ' Set the active document object Dim swDoc As ModelDoc2 Set swDoc = swApp.ActiveDoc ' Check if the active document is valid If swDoc Is Nothing Then MsgBox \"Unable to Connect to a Valid SOLIDWORKS Drawing.\", vbCritical Exit Sub End If ' Ensure the active document is a drawing If swDoc.GetType <> SwConst.swDocumentTypes_e.swDocDRAWING Then MsgBox \"The active document is not a SOLIDWORKS drawing.\", vbCritical Exit Sub End If ' Set the drawing document object Dim swDwgDoc As DrawingDoc Set swDwgDoc = swDoc ' Set the PDF export data object Dim swExportPdfData As SldWorks.ExportPdfData Set swExportPdfData = swApp.GetExportFileData(SwConst.swExportDataFileType_e.swExportPdfData) ' Get the output directory from the drawing's path Dim outputPath As String outputPath = GetFolderFromPath(swDoc.GetPathName) ' Get the list of sheet names in the drawing Dim sheetNames As Variant sheetNames = swDwgDoc.GetSheetNames ' Set the current sheet object Dim swSheet As Sheet Set swSheet = swDwgDoc.GetCurrentSheet ' Generate the base output file name Dim outputFileName As String outputFileName = GetFileNameFromTitle(swDoc.GetTitle, swSheet.GetName) ' Initialize variables for error handling Dim lErrors As Long Dim lWarnings As Long Dim i As Integer Dim exportSuccess As Boolean ' Display the export status in the SOLIDWORKS status bar Dim statusBarPane As StatusBarPane Dim swFrame As SldWorks.Frame Set swFrame = swApp.Frame Set statusBarPane = swFrame.GetStatusBarPane statusBarPane.Visible = True ' Loop through each sheet and export to PDF For i = 0 To UBound(sheetNames) ' Update the status bar with the current sheet being exported statusBarPane.Text = \"Exporting sheet: \" & sheetNames(i) ' Set the current sheet for PDF export exportSuccess = swExportPdfData.SetSheets(SwConst.swExportDataSheetsToExport_e.swExportData_ExportSpecifiedSheets, sheetNames(i)) ' Check for errors in setting the sheet If Not exportSuccess Then MsgBox \"Error exporting sheet: \" & Str(i), vbCritical Exit Sub End If ' Export the current sheet as PDF exportSuccess = swDoc.Extension.SaveAs(sheetNames(i) & \".pdf\", SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, _ SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent, swExportPdfData, lErrors, lWarnings) ' Check for errors during the export If Not exportSuccess Then MsgBox \"Error exporting sheet: \" & Str(i), vbCritical HandleErrors lErrors Exit Sub End If Next i End Sub ' Function to get the folder path from the full file path Private Function GetFolderFromPath(fullPath As String) As String GetFolderFromPath = Left(fullPath, InStrRev(fullPath, \"\\\")) End Function ' Function to get the file name without the sheet name Private Function GetFileNameFromTitle(fullTitle As String, sheetName As String) As String GetFileNameFromTitle = Left(fullTitle, InStrRev(fullTitle, sheetName) - 1) End Function ' Sub to handle errors based on error codes Private Sub HandleErrors(errorCode As Long) Select Case errorCode Case SwConst.swFileSaveError_e.swGenericSaveError MsgBox \"File Saving Error\", vbExclamation Case SwConst.swFileSaveError_e.swReadOnlySaveError MsgBox \"File Saving Error: Read-Only Rights\", vbExclamation Case SwConst.swFileSaveError_e.swFileNameEmpty MsgBox \"File Saving Error: Empty Filename\", vbExclamation Case SwConst.swFileSaveError_e.swFileNameContainsAtSign MsgBox \"File Saving Error: Invalid FileName Character\", vbExclamation Case SwConst.swFileSaveError_e.swFileSaveFormatNotAvailable MsgBox \"File Saving Error: Invalid File Format\", vbExclamation Case SwConst.swFileSaveError_e.swFileSaveAsNameExceedsMaxPathLength MsgBox \"File Saving Error: Filename Exceeds Maximum Path Length\", vbExclamation End Select End Sub Customization Need to modify the macro to meet specific requirements or integrate it with other processes? We provide custom macro development tailored to your needs. Contact us." }, + "src/Traverse and Export SOLIDWORKS Components to DXF.html": { + "href": "src/Traverse and Export SOLIDWORKS Components to DXF.html", + "title": "Traverse and Export SOLIDWORKS Components to DXF | 🧩 SOLIDWORKS VBA Macros Library", + "keywords": "Traverse and Export SOLIDWORKS Components to DXF Description This VBA macro automates traversing through all components of an active SOLIDWORKS assembly and exporting each part as a DXF file. It handles traversing, exporting flat patterns for sheet metal parts, and saving to a specified location. System Requirements SOLIDWORKS Version: SOLIDWORKS 2018 or later VBA Environment: Pre-installed with SOLIDWORKS (Access via Tools > Macro > New or Edit) Operating System: Windows 7, 8, 10, or later VBA Code: Option Explicit ' DISCLAIMER: ' This macro is provided \"as is\" without any warranty. Blue Byte Systems Inc. is not liable for any issues that arise ' from its use. Always test the macro in a safe environment before applying it to production data. Sub Main() ' Initialize SOLIDWORKS application and set active document Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Set swApp = CreateObject(\"SldWorks.Application\") Set swModel = swApp.ActiveDoc ' Prompt user for save path Dim savePath As String savePath = InputBox(\"Where do you want to save the files?\") ' Traverse the active document to process components TraverseComponents swApp.ActiveDoc, savePath End Sub ' Traverse through components and process each one Sub TraverseComponents(swModel As ModelDoc2, savePath As String) Dim swApp As SldWorks.SldWorks Dim swRootComp As SldWorks.Component2 Dim swConf As SldWorks.Configuration Dim swConfMgr As SldWorks.ConfigurationManager Dim vChildComp As Variant Dim i As Long Dim swChildComp As SldWorks.Component2 ' Set the application object Set swApp = CreateObject(\"SldWorks.Application\") Set swConfMgr = swModel.ConfigurationManager Set swConf = swConfMgr.ActiveConfiguration Set swRootComp = swConf.GetRootComponent3(True) ' Get child components vChildComp = swRootComp.GetChildren ' Loop through each child component For i = 0 To UBound(vChildComp) Set swChildComp = vChildComp(i) Set swModel = swChildComp.GetModelDoc2 ' Check if the model exists If Not swModel Is Nothing Then If swModel.GetType = swDocASSEMBLY Then ' Recursively traverse sub-assemblies TraverseComponents swModel, savePath Else ' Process part (e.g., save as STL or DXF) ProcessPartToDXF swModel, savePath End If End If Next i End Sub ' Process and export flat pattern of the part as DXF Sub ProcessPartToDXF(swModel As SldWorks.ModelDoc2, savePath As String) Dim swFeat As SldWorks.Feature Dim swFlatFeat As SldWorks.Feature ' Iterate through features to find flat pattern Set swFeat = swModel.FirstFeature Do While Not swFeat Is Nothing If swFeat.GetTypeName = \"FlatPattern\" Then Set swFlatFeat = swFeat swFeat.Select (True) swModel.EditUnsuppress2 ' Export the flat pattern as DXF ExportToDXF swModel, savePath ' Suppress the flat pattern after exporting swFlatFeat.Select (True) swModel.EditSuppress2 End If Set swFeat = swFeat.GetNextFeature Loop End Sub ' Export the flat pattern to DXF Sub ExportToDXF(swModel As SldWorks.ModelDoc2, savePath As String) Dim swPart As SldWorks.PartDoc Dim sModelName As String Dim sPathName As String Dim options As Long Dim dataAlignment(11) As Double ' Setup default alignment for export dataAlignment(0) = 0#: dataAlignment(1) = 0#: dataAlignment(2) = 0# dataAlignment(3) = 1#: dataAlignment(4) = 0#: dataAlignment(5) = 0# dataAlignment(6) = 0#: dataAlignment(7) = 1#: dataAlignment(8) = 0# dataAlignment(9) = 0#: dataAlignment(10) = 0#: dataAlignment(11) = 1# ' Get model and path names sModelName = swModel.GetPathName sPathName = savePath & \"\\\" & swModel.GetTitle & \".dxf\" ' Set export options options = 13 ' Export flat pattern geometry, bend lines, and sketches ' Perform DXF export Set swPart = swModel swPart.ExportToDWG sPathName, sModelName, 1, True, dataAlignment, False, False, options, Null End Sub ' Function to extract the title from a file path Public Function GetTitle(filePath As String) As String Dim pathParts As Variant pathParts = Split(filePath, \"\\\") GetTitle = Left(pathParts(UBound(pathParts)), InStr(pathParts(UBound(pathParts)), \".\") - 1) End Function Customization Need to modify the macro to meet specific requirements or integrate it with other processes? We provide custom macro development tailored to your needs. Contact us." + }, "src/addmasscenter.html": { "href": "src/addmasscenter.html", "title": "Add Center of Mass to a Part in SOLIDWORKS | 🧩 SOLIDWORKS VBA Macros Library", diff --git a/docs/manifest.json b/docs/manifest.json index 9ba7d71..2a0f7d7 100644 --- a/docs/manifest.json +++ b/docs/manifest.json @@ -95,6 +95,16 @@ }, "version": "" }, + { + "type": "Conceptual", + "source_relative_path": "src/Traverse and Export SOLIDWORKS Components to DXF.md", + "output": { + ".html": { + "relative_path": "src/Traverse and Export SOLIDWORKS Components to DXF.html" + } + }, + "version": "" + }, { "type": "Conceptual", "source_relative_path": "src/addmasscenter.md", diff --git a/docs/sitemap.xml b/docs/sitemap.xml index 4f57339..4cb0976 100644 --- a/docs/sitemap.xml +++ b/docs/sitemap.xml @@ -2,67 +2,73 @@ https://solidworksvbamacros.bluebyte.biz/README.html - 2024-09-16T10:00:39-07:00 + 2024-09-16T10:45:06-07:00 daily 0.5 https://solidworksvbamacros.bluebyte.biz/index.html - 2024-09-16T10:00:39-07:00 + 2024-09-16T10:45:06-07:00 daily 0.5 https://solidworksvbamacros.bluebyte.biz/src/Align_All_Dimensions_Automatically.html - 2024-09-16T10:00:39-07:00 + 2024-09-16T10:45:06-07:00 daily 0.5 https://solidworksvbamacros.bluebyte.biz/src/Rebuild_Save_All_Drawings_in_a_Directory_as_PDF.html - 2024-09-16T10:00:39-07:00 + 2024-09-16T10:45:06-07:00 daily 0.5 https://solidworksvbamacros.bluebyte.biz/src/Save_Each_Sheet_As_PDF.html - 2024-09-16T10:00:39-07:00 + 2024-09-16T10:45:06-07:00 + daily + 0.5 + + + https://solidworksvbamacros.bluebyte.biz/src/Traverse%20and%20Export%20SOLIDWORKS%20Components%20to%20DXF.html + 2024-09-16T10:45:06-07:00 daily 0.5 https://solidworksvbamacros.bluebyte.biz/src/addmasscenter.html - 2024-09-16T10:00:39-07:00 + 2024-09-16T10:45:06-07:00 daily 0.5 https://solidworksvbamacros.bluebyte.biz/src/assembly_export_dxf.html - 2024-09-16T10:00:39-07:00 + 2024-09-16T10:45:06-07:00 daily 0.5 https://solidworksvbamacros.bluebyte.biz/src/create_boundingbox_feature_for_all_components.html - 2024-09-16T10:00:39-07:00 + 2024-09-16T10:45:06-07:00 daily 0.5 https://solidworksvbamacros.bluebyte.biz/src/exportbomtoexcelwiththumbnails.html - 2024-09-16T10:00:39-07:00 + 2024-09-16T10:45:06-07:00 daily 0.5 https://solidworksvbamacros.bluebyte.biz/src/introduction.html - 2024-09-16T10:00:39-07:00 + 2024-09-16T10:45:06-07:00 daily 0.5 https://solidworksvbamacros.bluebyte.biz/src/traverse_assembly_component_tree_recursively_solidworks_vba_macro.html - 2024-09-16T10:00:39-07:00 + 2024-09-16T10:45:06-07:00 daily 0.5 diff --git a/docs/src/Traverse and Export SOLIDWORKS Components to DXF.html b/docs/src/Traverse and Export SOLIDWORKS Components to DXF.html new file mode 100644 index 0000000..946396c --- /dev/null +++ b/docs/src/Traverse and Export SOLIDWORKS Components to DXF.html @@ -0,0 +1,242 @@ + + + + + Traverse and Export SOLIDWORKS Components to DXF | 🧩 SOLIDWORKS VBA Macros Library + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ +
+ +
+
+
+
+
Table of Contents
+ +
+
+ +
+
+
+ +
+
+ + + +
+ +
+

Traverse and Export SOLIDWORKS Components to DXF

+ +

Description

+

This VBA macro automates traversing through all components of an active SOLIDWORKS assembly and exporting each part as a DXF file. It handles traversing, exporting flat patterns for sheet metal parts, and saving to a specified location.

+

System Requirements

+
    +
  • SOLIDWORKS Version: SOLIDWORKS 2018 or later
    • +
  • VBA Environment: Pre-installed with SOLIDWORKS (Access via Tools > Macro > New or Edit)
    • +
  • Operating System: Windows 7, 8, 10, or later
    • +
+

VBA Code:

+
Option Explicit
+
+' DISCLAIMER: 
+' This macro is provided "as is" without any warranty. Blue Byte Systems Inc. is not liable for any issues that arise 
+' from its use. Always test the macro in a safe environment before applying it to production data.
+
+Sub Main()
+    ' Initialize SOLIDWORKS application and set active document
+    Dim swApp As SldWorks.SldWorks
+    Dim swModel As SldWorks.ModelDoc2
+    Set swApp = CreateObject("SldWorks.Application")
+    Set swModel = swApp.ActiveDoc
+
+    ' Prompt user for save path
+    Dim savePath As String
+    savePath = InputBox("Where do you want to save the files?")
+
+    ' Traverse the active document to process components
+    TraverseComponents swApp.ActiveDoc, savePath
+End Sub
+
+' Traverse through components and process each one
+Sub TraverseComponents(swModel As ModelDoc2, savePath As String)
+    Dim swApp As SldWorks.SldWorks
+    Dim swRootComp As SldWorks.Component2
+    Dim swConf As SldWorks.Configuration
+    Dim swConfMgr As SldWorks.ConfigurationManager
+    Dim vChildComp As Variant
+    Dim i As Long
+    Dim swChildComp As SldWorks.Component2
+    
+    ' Set the application object
+    Set swApp = CreateObject("SldWorks.Application")
+    Set swConfMgr = swModel.ConfigurationManager
+    Set swConf = swConfMgr.ActiveConfiguration
+    Set swRootComp = swConf.GetRootComponent3(True)
+    
+    ' Get child components
+    vChildComp = swRootComp.GetChildren
+    
+    ' Loop through each child component
+    For i = 0 To UBound(vChildComp)
+        Set swChildComp = vChildComp(i)
+        Set swModel = swChildComp.GetModelDoc2
+        
+        ' Check if the model exists
+        If Not swModel Is Nothing Then
+            If swModel.GetType = swDocASSEMBLY Then
+                ' Recursively traverse sub-assemblies
+                TraverseComponents swModel, savePath
+            Else
+                ' Process part (e.g., save as STL or DXF)
+                ProcessPartToDXF swModel, savePath
+            End If
+        End If
+    Next i
+End Sub
+
+' Process and export flat pattern of the part as DXF
+Sub ProcessPartToDXF(swModel As SldWorks.ModelDoc2, savePath As String)
+    Dim swFeat As SldWorks.Feature
+    Dim swFlatFeat As SldWorks.Feature
+    
+    ' Iterate through features to find flat pattern
+    Set swFeat = swModel.FirstFeature
+    Do While Not swFeat Is Nothing
+        If swFeat.GetTypeName = "FlatPattern" Then
+            Set swFlatFeat = swFeat
+            swFeat.Select (True)
+            swModel.EditUnsuppress2
+            
+            ' Export the flat pattern as DXF
+            ExportToDXF swModel, savePath
+            
+            ' Suppress the flat pattern after exporting
+            swFlatFeat.Select (True)
+            swModel.EditSuppress2
+        End If
+        Set swFeat = swFeat.GetNextFeature
+    Loop
+End Sub
+
+' Export the flat pattern to DXF
+Sub ExportToDXF(swModel As SldWorks.ModelDoc2, savePath As String)
+    Dim swPart As SldWorks.PartDoc
+    Dim sModelName As String
+    Dim sPathName As String
+    Dim options As Long
+    Dim dataAlignment(11) As Double
+    
+    ' Setup default alignment for export
+    dataAlignment(0) = 0#: dataAlignment(1) = 0#: dataAlignment(2) = 0#
+    dataAlignment(3) = 1#: dataAlignment(4) = 0#: dataAlignment(5) = 0#
+    dataAlignment(6) = 0#: dataAlignment(7) = 1#: dataAlignment(8) = 0#
+    dataAlignment(9) = 0#: dataAlignment(10) = 0#: dataAlignment(11) = 1#
+    
+    ' Get model and path names
+    sModelName = swModel.GetPathName
+    sPathName = savePath & "\" & swModel.GetTitle & ".dxf"
+    
+    ' Set export options
+    options = 13 ' Export flat pattern geometry, bend lines, and sketches
+    
+    ' Perform DXF export
+    Set swPart = swModel
+    swPart.ExportToDWG sPathName, sModelName, 1, True, dataAlignment, False, False, options, Null
+End Sub
+
+' Function to extract the title from a file path
+Public Function GetTitle(filePath As String) As String
+    Dim pathParts As Variant
+    pathParts = Split(filePath, "\")
+    GetTitle = Left(pathParts(UBound(pathParts)), InStr(pathParts(UBound(pathParts)), ".") - 1)
+End Function
+
+

Customization

+

Need to modify the macro to meet specific requirements or integrate it with other processes? We provide custom macro development tailored to your needs. Contact us.

+ +
+ +
+ Edit this page +
+ + + +
+ +
+ +
+
+ +
+ + + + diff --git a/docs/src/toc.html b/docs/src/toc.html index c560fef..e4566c0 100644 --- a/docs/src/toc.html +++ b/docs/src/toc.html @@ -40,7 +40,10 @@