diff --git a/edrawings-api/output/export/index.md b/edrawings-api/output/export/index.md index cdc0caa0..86bc921f 100644 --- a/edrawings-api/output/export/index.md +++ b/edrawings-api/output/export/index.md @@ -37,7 +37,7 @@ Please see below example of parameters * Export all SOLIDWORKS files (matching the filter *.sld*, i.e. extension starts with .sld) from the *SW Drawings* and *SW Models* folders in drive C (including sub folders) to the *C:\EDRW* folder in eDrawings format (.eprt for parts, .easm for assemblies, .edrw for drawing) and html format. ~~~ -> export.exe -input "C:\SW Drawings" "C:\SW Models" -output C:\EDRW -filter *.sld* -format .e .html +> export.exe -input "C:\SW Drawings" "C:\SW Models" -outdir C:\EDRW -filter *.sld* -format .e .html ~~~ * Export *C:\Models\Part.sldprt* into *C:\Models\Part.eprt* diff --git a/edrawings-api/output/print-to-pdf/index.md b/edrawings-api/output/print-to-pdf/index.md index 6b314f22..ca5ecbdb 100644 --- a/edrawings-api/output/print-to-pdf/index.md +++ b/edrawings-api/output/print-to-pdf/index.md @@ -11,7 +11,7 @@ group: Import/Export This console application developed in VB.NET allows to export SOLIDWORKS, DXF, DWG files to PDF using free version of SOLIDWORKS eDrawings via its API. It is not required to have SOLIDWORKS installed or use its license to use this tool. This tool is supported on Windows 8.1 onwards. -This functionality has been integrated into the [xPort](https://cadplus.xarial.com/xport/) utility. +This functionality has been integrated into the [eXport+](https://cadplus.xarial.com/export/) utility. ## Running the tool diff --git a/labs/solidworks/swex/add-in/hosting-user-controls/task-pane/index.md b/labs/solidworks/swex/add-in/hosting-user-controls/task-pane/index.md index b1e559f9..e58433cc 100644 --- a/labs/solidworks/swex/add-in/hosting-user-controls/task-pane/index.md +++ b/labs/solidworks/swex/add-in/hosting-user-controls/task-pane/index.md @@ -33,7 +33,7 @@ public partial class MyComVisibleControlHost : UserControl } ~~~ -It is recommended to use COM-visible controls when hosting Windows Presentation Foundation (WCF) control in [System.Windows.Forms.Integration.ElementHost](https://docs.microsoft.com/en-us/dotnet/api/system.windows.forms.integration.elementhost?view=netframework-4.8) as keypresses might not be handled properly in com-invisible controls. +It is recommended to use COM-visible controls when hosting Windows Presentation Foundation (WPF) control in [System.Windows.Forms.Integration.ElementHost](https://docs.microsoft.com/en-us/dotnet/api/system.windows.forms.integration.elementhost?view=netframework-4.8) as keypresses might not be handled properly in com-invisible controls. ## Defining Commands diff --git a/solidworks-api/document/assembly/components/align-configurations/Macro.vba b/solidworks-api/document/assembly/components/align-configurations/Macro.vba new file mode 100644 index 00000000..998c6ac5 --- /dev/null +++ b/solidworks-api/document/assembly/components/align-configurations/Macro.vba @@ -0,0 +1,165 @@ +Const ROOT_CONFS_ONLY As Boolean = True + +Dim swApp As SldWorks.SldWorks + +Sub main() + + Set swApp = Application.SldWorks + + Dim swModel As SldWorks.ModelDoc2 + + Set swModel = swApp.ActiveDoc + + Dim swAssy As SldWorks.AssemblyDoc + + Set swAssy = swModel + + If Not swAssy Is Nothing Then + + Dim vComps As Variant + vComps = GetSelectedRootComponents(swAssy) + + If Not IsEmpty(vComps) Then + + Dim vConfs As Variant + vConfs = swModel.GetConfigurationNames + + Dim i As Integer + + For i = 0 To UBound(vConfs) + + Dim swConf As SldWorks.Configuration + Set swConf = swModel.GetConfigurationByName(CStr(vConfs(i))) + + If swConf.GetParent() Is Nothing Or Not ROOT_CONFS_ONLY Then + + Dim confParams() As String + Dim confParamVals() As String + + ReDim confParams(UBound(vComps)) + ReDim confParamVals(UBound(vComps)) + + Dim j As Integer + + For j = 0 To UBound(vComps) + + Dim swComp As SldWorks.Component2 + Set swComp = vComps(j) + + If HasConfiguration(swComp, swConf.Name) Then + + confParams(j) = "$CONFIGURATION@" & GetComponentNameForParameter(swComp) + confParamVals(j) = swConf.Name + + Else + Err.Raise vbError, "", swComp.Name2 & " does not contain configuration " & swConf.Name + End If + + Next + + swConf.SetParameters (confParams), (confParamVals) + + End If + + Next + + Else + Err.Raise vbError, "", "Select components to process" + End If + + Else + Err.Raise vbError, "", "Open assembly" + End If + +End Sub + +Function GetSelectedRootComponents(assm As SldWorks.AssemblyDoc) As Variant + + Dim swComps() As SldWorks.Component2 + + Dim swSelMgr As SldWorks.SelectionMgr + + Set swSelMgr = assm.SelectionManager + + Dim i As Integer + + For i = 1 To swSelMgr.GetSelectedObjectCount2(-1) + + Dim swComp As SldWorks.Component2 + Set swComp = swSelMgr.GetSelectedObjectsComponent4(i, -1) + + If Not swComp Is Nothing Then + + If swComp.GetParent() Is Nothing Then + + If (Not swComps) = -1 Then + ReDim swComps(0) + Else + ReDim Preserve swComps(UBound(swComps) + 1) + End If + + Set swComps(UBound(swComps)) = swComp + + Else + Err.Raise vbError, "", "Only top level components are supported" + End If + + End If + + Next + + If (Not swComps) = -1 Then + GetSelectedRootComponents = Empty + Else + GetSelectedRootComponents = swComps + End If + +End Function + +Function GetComponentNameForParameter(comp As SldWorks.Component2) As String + + Dim instId As Integer + Dim compName As String + compName = comp.Name2 + instId = CInt(Right(compName, Len(compName) - InStrRev(compName, "-"))) + compName = Left(compName, InStrRev(compName, "-") - 1) + + GetComponentNameForParameter = compName & "<" & instId & ">" + +End Function + +Function HasConfiguration(comp As SldWorks.Component2, confName As String) As Boolean + + Dim swRefModel As SldWorks.ModelDoc2 + Set swRefModel = comp.GetModelDoc2 + + Dim vConfs As Variant + + If Not swRefModel Is Nothing Then + vConfs = swRefModel.GetConfigurationNames + Else + vConfs = swApp.GetConfigurationNames(comp.GetPathName()) + End If + + HasConfiguration = Contains(vConfs, confName) + +End Function + +Function Contains(vArr As Variant, item As String) As Boolean + + Contains = False + + If Not IsEmpty(vArr) Then + + Dim i As Integer + + For i = 0 To UBound(vArr) + If LCase(CStr(vArr(i))) = LCase(item) Then + Contains = True + Exit Function + End If + Next + + End If + +End Function \ No newline at end of file diff --git a/solidworks-api/document/assembly/components/align-configurations/index.md b/solidworks-api/document/assembly/components/align-configurations/index.md new file mode 100644 index 00000000..0878a379 --- /dev/null +++ b/solidworks-api/document/assembly/components/align-configurations/index.md @@ -0,0 +1,22 @@ +--- +caption: Align Referenced Configurations +title: VBA macro to align referenced configuration of components to assembly configurations +description: VBA macro aligns referenced configuration of selected components in the SOLIDWORKS assembly to the corresponding assembly configurations +image: modify-configurations.png +--- + +This VBA macro aligns the referenced configurations of all selected components to the corresponding assembly configuration. For example if assembly has 3 configurations **A**, **B** and **C**, then referenced configurations for all selected components will be set to **A**, **B** and **C** in the respective configuration of the assembly. + +![Modify component configurations](modify-configurations.png){ width=600 } + +Macro processes all root configurations (or optionally all configurations) + +~~~ vb +Const ROOT_CONFS_ONLY As Boolean = False 'Process all assembly configurations +~~~ + +Multiple components can be selected and processed at the same time. Only top level-components are supported. For aligning configurations for sub-assembly, it is required to activate the sub-assembly in its own window. + +Components in the lightweight mode are supported. + +{% code-snippet { file-name: Macro.vba } %} \ No newline at end of file diff --git a/solidworks-api/document/assembly/components/align-configurations/modify-configurations.png b/solidworks-api/document/assembly/components/align-configurations/modify-configurations.png new file mode 100644 index 00000000..06a2df3f Binary files /dev/null and b/solidworks-api/document/assembly/components/align-configurations/modify-configurations.png differ diff --git a/solidworks-api/document/assembly/components/copy-path/Macro.vba b/solidworks-api/document/assembly/components/copy-path/Macro.vba index c9e816fa..2406c66a 100644 --- a/solidworks-api/document/assembly/components/copy-path/Macro.vba +++ b/solidworks-api/document/assembly/components/copy-path/Macro.vba @@ -3,55 +3,70 @@ Dim swModel As SldWorks.ModelDoc2 Sub main() +try_: + On Error GoTo catch_ + Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc + Dim path As String + If Not swModel Is Nothing Then Dim swSelMgr As SldWorks.SelectionMgr Set swSelMgr = swModel.SelectionManager - Dim swComp As SldWorks.Component2 + Dim i As Integer - If TypeOf swModel Is SldWorks.AssemblyDoc Then - - Set swComp = swSelMgr.GetSelectedObjectsComponent4(1, -1) - - ElseIf TypeOf swModel Is SldWorks.DrawingDoc Then - - Dim swDrawComp As SldWorks.DrawingComponent - Set swDrawComp = swSelMgr.GetSelectedObjectsComponent4(1, -1) + For i = 1 To swSelMgr.GetSelectedObjectCount2(-1) + + Dim swComp As SldWorks.Component2 + Set swComp = Nothing - If swDrawComp Is Nothing Then - 'for entities selected in graphics view - first seleciton is a view itself - Set swDrawComp = swSelMgr.GetSelectedObjectsComponent4(2, -1) + If TypeOf swModel Is SldWorks.AssemblyDoc Then + + Set swComp = swSelMgr.GetSelectedObjectsComponent4(i, -1) + + ElseIf TypeOf swModel Is SldWorks.DrawingDoc Then + + Dim swDrawComp As SldWorks.DrawingComponent + Set swDrawComp = swSelMgr.GetSelectedObjectsComponent4(i, -1) + + If Not swDrawComp Is Nothing Then + Set swComp = swDrawComp.Component + End If + + Else + Err.Raise vbError, "", "Only parts and drawings are supported" End If - If Not swDrawComp Is Nothing Then - Set swComp = swDrawComp.Component + If Not swComp Is Nothing Then + If path <> "" Then + path = path & vbLf + End If + path = path & swComp.GetPathName End If - Else - MsgBox "Only parts and drawings are supported" - End - End If + Next - If Not swComp Is Nothing Then - - Dim path As String - path = swComp.GetPathName + If path <> "" Then Debug.Print path SetTextToClipboard path - Else - MsgBox "Please select component" + Err.Raise vbError, "", "Please select components" End If Else - MsgBox "Please open document" + Err.Raise vbError, "", "Please open document" End If + GoTo finally_ + +catch_: + swApp.SendMsgToUser2 Err.Description, swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk +finally_: + End Sub Sub SetTextToClipboard(text As String) diff --git a/solidworks-api/document/assembly/components/copy-path/index.md b/solidworks-api/document/assembly/components/copy-path/index.md index 9e4b3d33..66349361 100644 --- a/solidworks-api/document/assembly/components/copy-path/index.md +++ b/solidworks-api/document/assembly/components/copy-path/index.md @@ -1,18 +1,18 @@ --- layout: sw-tool -title: Macro to copy path of SOLIDWORKS component to clipboard +title: Macro to copy path of SOLIDWORKS components to clipboard caption: Copy Component Path -description: Macro copies the path of the selected component in assembly or drawing into the clipboard using SOLIDWORKS API +description: Macro copies the path of the selected components in assembly or drawing into the clipboard using SOLIDWORKS API image: copy-component-path.png labels: [path, clipboard, component] group: Assembly --- ![Component selected in the feature tree](selected-component.png){ width=250 } -This macro copies the full path to the selected component into the clipboard using SOLIDWORKS API. +This macro copies the full path to the selected components into the clipboard using SOLIDWORKS API. -* Component can be selected in assembly or drawing document -* Component can be selected in the feature tree or in the graphics area +* Components can be selected in assembly or drawing document +* Components can be selected in the feature tree or in the graphics area * It is also possible to select a component entity (i.e. face or edge) to get the path to the component {% code-snippet { file-name: Macro.vba } %} diff --git a/solidworks-api/document/assembly/components/purge-configurations/index.md b/solidworks-api/document/assembly/components/purge-configurations/index.md index f1cb4cde..0c31f3cf 100644 --- a/solidworks-api/document/assembly/components/purge-configurations/index.md +++ b/solidworks-api/document/assembly/components/purge-configurations/index.md @@ -7,7 +7,7 @@ image: purged-components-result1.png labels: [component, replace, purge] group: Assembly --- -In some cases it might be required to remove (purge) all unused configurations from the components in the assembly. It is in particular useful for the fastener or toolbox components as file can contains thousands of configurations but only few are used in the assembly. +In some cases it might be required to remove (purge) all unused configurations from the components in the assembly. It is in particular useful for the fastener or toolbox components as file can contain thousands of configurations but only few are used in the assembly. This macro allows to create a copy of all selected components, purge their configurations and replace them in the assembly. diff --git a/solidworks-api/document/assembly/components/show-selected-assembly-component-window-folder/macro.vba b/solidworks-api/document/assembly/components/show-selected-assembly-component-window-folder/macro.vba index 2c1ad206..4c879b22 100644 --- a/solidworks-api/document/assembly/components/show-selected-assembly-component-window-folder/macro.vba +++ b/solidworks-api/document/assembly/components/show-selected-assembly-component-window-folder/macro.vba @@ -26,7 +26,7 @@ Sub main() End If If path <> "" Then - Shell "explorer.exe /select, " & """" & path & """" + Shell "explorer.exe /select, " & """" & path & """", vbMaximizedFocus Else MsgBox "Model is not saved" End If @@ -35,4 +35,4 @@ Sub main() MsgBox "Please open assembly document and select the component" End If -End Sub +End Sub \ No newline at end of file diff --git a/solidworks-api/document/assembly/compose-flat-bom/Macro.vba b/solidworks-api/document/assembly/compose-flat-bom/Macro.vba index fe436552..1af7ed79 100644 --- a/solidworks-api/document/assembly/compose-flat-bom/Macro.vba +++ b/solidworks-api/document/assembly/compose-flat-bom/Macro.vba @@ -131,12 +131,12 @@ Function GetPropertyValue(model As SldWorks.ModelDoc2, conf As String, prpName A Dim prpVal As String Dim prpResVal As String - confSpecPrpMgr.Get3 prpName, False, "", prpVal + confSpecPrpMgr.Get3 prpName, False, prpVal, prpResVal - If prpVal = "" Then + If prpResVal = "" Then genPrpMgr.Get3 prpName, False, prpVal, prpResVal End If GetPropertyValue = prpResVal -End Function \ No newline at end of file +End Function diff --git a/solidworks-api/document/cut-lists/copy-custom-properties/Macro.vba b/solidworks-api/document/cut-lists/copy-custom-properties/Macro.vba index a4127a1d..343ffa98 100644 --- a/solidworks-api/document/cut-lists/copy-custom-properties/Macro.vba +++ b/solidworks-api/document/cut-lists/copy-custom-properties/Macro.vba @@ -1,12 +1,20 @@ -Const CONF_SPEC_PRP As Boolean = False +Const CONF_SPEC_PRP As Boolean = True Const COPY_RES_VAL As Boolean = True -Dim PROPERTIES As Variant +Const ALL_CONFS As Boolean = False +Const PROCESS_TOP_LEVEL_CONFIGS As Boolean = False +Const PROCESS_CHILDREN_CONFIGS As Boolean = True + +Dim SRC_PROPERTIES As Variant +Dim TARG_PROPERTIES As Variant Dim swApp As SldWorks.SldWorks -Sub Init(Optional dummy As Variant = Empty) - PROPERTIES = Array("Bounding Box Length", "Bounding Box Width", "Sheet Metal Thickness") 'list of custom properties to copy or Empty to copy all +Sub Init(Optional dummy As Variant = Empty) + + SRC_PROPERTIES = Array("Bounding Box Length", "Bounding Box Width", "Sheet Metal Thickness") 'list of custom properties to copy or Empty to copy all + TARG_PROPERTIES = Array("Length", "Width", "Thickness") 'list of target custom property namesor Empty to use original name + End Sub Sub main() @@ -22,24 +30,38 @@ try_: Dim swModel As SldWorks.ModelDoc2 Set swModel = swApp.ActiveDoc - Dim swCutListPrpMgr As SldWorks.CustomPropertyManager - Set swCutListPrpMgr = GetCutListPropertyManager(swModel) + Dim activeConfName As String + activeConfName = swModel.ConfigurationManager.ActiveConfiguration.Name - If Not swCutListPrpMgr Is Nothing Then + Dim vConfNames As Variant + vConfNames = GetConfigurations(swModel) + + Dim i As Integer + + For i = 0 To UBound(vConfNames) + + swModel.ShowConfiguration2 CStr(vConfNames(i)) - Dim swTargetPrpMgr As SldWorks.CustomPropertyManager + Dim swCutListPrpMgr As SldWorks.CustomPropertyManager + Set swCutListPrpMgr = GetCutListPropertyManager(swModel) - If CONF_SPEC_PRP Then - Set swTargetPrpMgr = swModel.ConfigurationManager.ActiveConfiguration.CustomPropertyManager + If Not swCutListPrpMgr Is Nothing Then + + Dim swTargetPrpMgr As SldWorks.CustomPropertyManager + + If CONF_SPEC_PRP Then + Set swTargetPrpMgr = swModel.ConfigurationManager.ActiveConfiguration.CustomPropertyManager + Else + Set swTargetPrpMgr = swModel.Extension.CustomPropertyManager("") + End If + + CopyProperties swCutListPrpMgr, swTargetPrpMgr, SRC_PROPERTIES, TARG_PROPERTIES + Else - Set swTargetPrpMgr = swModel.Extension.CustomPropertyManager("") + Err.Raise vbError, "", "Cut-list is not found" End If - - CopyProperties swCutListPrpMgr, swTargetPrpMgr, PROPERTIES - - Else - Err.Raise vbError, "", "Cut-list is not found" - End If + + Next GoTo finally_ @@ -47,6 +69,10 @@ catch_: swApp.SendMsgToUser2 Err.Description, swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk finally_: + If activeConfName <> "" Then + swModel.ShowConfiguration2 activeConfName + End If + End Sub Function GetCutListPropertyManager(model As SldWorks.ModelDoc2) As SldWorks.CustomPropertyManager @@ -58,8 +84,17 @@ Function GetCutListPropertyManager(model As SldWorks.ModelDoc2) As SldWorks.Cust While Not swFeat Is Nothing If swFeat.GetTypeName2() = "CutListFolder" Then - Set GetCutListPropertyManager = swFeat.CustomPropertyManager - Exit Function + + Dim swBodyFolder As SldWorks.BodyFolder + Set swBodyFolder = swFeat.GetSpecificFeature2 + + Dim bodyCount As Long + bodyCount = swBodyFolder.GetBodyCount + + If bodyCount <> 0 Then + Set GetCutListPropertyManager = swFeat.CustomPropertyManager + Exit Function + End If End If Set swFeat = swFeat.GetNextFeature @@ -68,33 +103,94 @@ Function GetCutListPropertyManager(model As SldWorks.ModelDoc2) As SldWorks.Cust End Function -Sub CopyProperties(srcPrpMgr As SldWorks.CustomPropertyManager, targPrpMgr As SldWorks.CustomPropertyManager, vPrpNames As Variant) +Sub CopyProperties(srcPrpMgr As SldWorks.CustomPropertyManager, targPrpMgr As SldWorks.CustomPropertyManager, vSrcPrpNames As Variant, vTargPrpNames As Variant) - If IsEmpty(vPrpNames) Then - vPrpNames = srcPrpMgr.GetNames() + If IsEmpty(vSrcPrpNames) Then + vSrcPrpNames = srcPrpMgr.GetNames() + vTargPrpNames = vSrcPrpNames + End If + + If IsEmpty(vTargPrpNames) Then + vTargPrpNames = vSrcPrpNames End If - If Not IsEmpty(vPrpNames) Then + If Not IsEmpty(vSrcPrpNames) Then + + If UBound(vSrcPrpNames) = UBound(vTargPrpNames) Then + + For i = 0 To UBound(vSrcPrpNames) + + Dim srcPrpName As String + + srcPrpName = vSrcPrpNames(i) - For i = 0 To UBound(vPrpNames) - - prpName = vPrpNames(i) + Dim prpVal As String + Dim prpResVal As String + + srcPrpMgr.Get5 srcPrpName, False, prpVal, prpResVal, False + + Dim targVal As String + targVal = IIf(COPY_RES_VAL, prpResVal, prpVal) + + Dim targPrpName As String + + targPrpName = vTargPrpNames(i) + + targPrpMgr.Add2 targPrpName, swCustomInfoType_e.swCustomInfoText, targVal + targPrpMgr.Set targPrpName, targVal + + Next + Else + Err.Raise vbError, "", "Target proeprties name do not match source" + End If + + Else + Err.Raise vbError, "", "No properties to copy" + End If + +End Sub - Dim prpVal As String - Dim prpResVal As String - - srcPrpMgr.Get5 prpName, False, prpVal, prpResVal, False +Function GetConfigurations(model As SldWorks.ModelDoc2) As Variant + + Dim confNames() As String + + If ALL_CONFS And CONF_SPEC_PRP Then + + Dim vConfNames As Variant + vConfNames = model.GetConfigurationNames + + Dim i As Integer + + For i = 0 To UBound(vConfNames) + + Dim confName As String + confName = CStr(vConfNames(i)) + + Dim swConf As SldWorks.Configuration + Set swConf = model.GetConfigurationByName(confName) - Dim targVal As String - targVal = IIf(COPY_RES_VAL, prpResVal, prpVal) + If swConf.Type = swConfigurationType_e.swConfiguration_Standard Then + + If (PROCESS_TOP_LEVEL_CONFIGS And swConf.GetParent() Is Nothing) Or (PROCESS_CHILDREN_CONFIGS And Not swConf.GetParent() Is Nothing) Then + If (Not confNames) = -1 Then + ReDim confNames(0) + Else + ReDim Preserve confNames(UBound(confNames) + 1) + End If + + confNames(UBound(confNames)) = confName + + End If - targPrpMgr.Add2 prpName, swCustomInfoType_e.swCustomInfoText, targVal - targPrpMgr.Set prpName, targVal + End If Next - + Else - Err.Raise vbError, "", "No properties to copy" + ReDim confNames(0) + confNames(0) = model.ConfigurationManager.ActiveConfiguration.Name End If -End Sub \ No newline at end of file + GetConfigurations = confNames + +End Function diff --git a/solidworks-api/document/cut-lists/copy-custom-properties/index.md b/solidworks-api/document/cut-lists/copy-custom-properties/index.md index 8b62450b..ec11dea3 100644 --- a/solidworks-api/document/cut-lists/copy-custom-properties/index.md +++ b/solidworks-api/document/cut-lists/copy-custom-properties/index.md @@ -11,12 +11,16 @@ This VBA macro copies the specified or all SOLIDWORKS custom properties from the Properties from the first found cut-list will be copied. -{% code-snippet { file-name: Macro.vba } %} - ## Configuration Macro can be configured by changing the constants +~~~ vb +Const ALL_CONFS As Boolean = False 'True to process all configurations +Const PROCESS_TOP_LEVEL_CONFIGS As Boolean = False 'True to process top level configurations +Const PROCESS_CHILDREN_CONFIGS As Boolean = True 'True to process children configurations +~~~ + ### Properties Scope *CONF_SPEC_PRP* constant sets the target properties scope. @@ -38,13 +42,19 @@ Macro can be configured by changing the constants ### Properties List -*PROPERTIES* array contains list of properties to copy +~~~ vb +Dim SRC_PROPERTIES As Variant +Dim TARG_PROPERTIES As Variant +~~~ + +*SRC_PROPERTIES* array contains list of property names to copy, *TARG_PROPERTIES* array contains list of properties to copy to Copy specified properties ~~~ vb Sub Init(Optional dummy As Variant = Empty) - PROPERTIES = Array("Prp1", "Prp2", "Prp3") 'Copy Prp1, Prp2, Prp3 + SRC_PROPERTIES = Array("Prp1", "Prp2", "Prp3") 'Copy Prp1, Prp2, Prp3 + TARG_PROPERTIES = Array("TargPrp1", "Prp2", "TargPrp3") 'Copy to TargPrp1, Prp2, TargPrp3 End Sub ~~~ @@ -52,6 +62,9 @@ Copy all properties ~~~ vb Sub Init(Optional dummy As Variant = Empty) - PROPERTIES = Empty + SRC_PROPERTIES = Empty + TARG_PROPERTIES = Empty End Sub -~~~ \ No newline at end of file +~~~ + +{% code-snippet { file-name: Macro.vba } %} \ No newline at end of file diff --git a/solidworks-api/document/dimensions/set-read-only/Macro.vba b/solidworks-api/document/dimensions/set-read-only/Macro.vba new file mode 100644 index 00000000..60c15cd6 --- /dev/null +++ b/solidworks-api/document/dimensions/set-read-only/Macro.vba @@ -0,0 +1,41 @@ +Const READ_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 swSelMgr As SldWorks.SelectionMgr + + Set swSelMgr = swModel.SelectionManager + + Dim swFeat As SldWorks.Feature + + Set swFeat = swSelMgr.GetSelectedObject6(1, -1) + + If Not swFeat Is Nothing Then + + Dim swDispDim As SldWorks.DisplayDimension + + Set swDispDim = swFeat.GetFirstDisplayDimension + + While Not swDispDim Is Nothing + + Dim swDim As SldWorks.Dimension + + Set swDim = swDispDim.GetDimension2(0) + swDim.ReadOnly = READ_ONLY + + Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim) + + Wend + + Else + Err.Raise vbError, "", "Select feature" + End If + +End Sub \ No newline at end of file diff --git a/solidworks-api/document/dimensions/set-read-only/dimension-read-only.png b/solidworks-api/document/dimensions/set-read-only/dimension-read-only.png new file mode 100644 index 00000000..85ed5b94 Binary files /dev/null and b/solidworks-api/document/dimensions/set-read-only/dimension-read-only.png differ diff --git a/solidworks-api/document/dimensions/set-read-only/index.md b/solidworks-api/document/dimensions/set-read-only/index.md new file mode 100644 index 00000000..82932830 --- /dev/null +++ b/solidworks-api/document/dimensions/set-read-only/index.md @@ -0,0 +1,18 @@ +--- +caption: Set To Read-Only +title: Macro to change read-only state of all dimensions of the selected feature in the SOLIDWORKS model +description: VBA macro to change the read-only options for all dimensions of the selected feature of the active SOLIdWORKS model +image: dimension-read-only.png +--- + +![Dimension read-only property](dimension-read-only.png){ width=400 } + +This SOLIDWORKS VBA macro changes the read-only state of all dimensions of the selected feature (e.g. sketch). + +Set the target read-only state in the constant + +~~~ vb +Const READ_ONLY As Boolean = True 'True to set to Read-Only, False to remove Rea-Only flag +~~~ + +{% code-snippet { file-name: Macro.vba } %} \ No newline at end of file diff --git a/solidworks-api/document/drawing/bom-tables-update-referenced-configuration/bom-table-conf.svg b/solidworks-api/document/drawing/bom-tables-update-referenced-configuration/bom-table-conf.svg new file mode 100644 index 00000000..9146aeeb --- /dev/null +++ b/solidworks-api/document/drawing/bom-tables-update-referenced-configuration/bom-table-conf.svg @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/solidworks-api/document/drawing/bom-tables-update-referenced-configuration/index.md b/solidworks-api/document/drawing/bom-tables-update-referenced-configuration/index.md index ef150d02..5c63bf04 100644 --- a/solidworks-api/document/drawing/bom-tables-update-referenced-configuration/index.md +++ b/solidworks-api/document/drawing/bom-tables-update-referenced-configuration/index.md @@ -2,7 +2,7 @@ title: SOLIDWORKS macro to update referenced configuration from BOM tables caption: Update Referenced Configuration From BOM Tables description: Macro will update the referenced configurations for all Bill of Materials (BOM) tables on the active drawing document using SOLIDWORKS API -image: bom-configurations-property.png +image: bom-table-conf.svg labels: [bom, default view, referenced configuration, solidworks api, utility, view] redirect-from: - /2018/03/update-referenced-configuration-from.html diff --git a/solidworks-api/document/drawing/propagate-configurations-sheets/Macro.vba b/solidworks-api/document/drawing/propagate-configurations-sheets/Macro.vba index 9ce6018e..63ebf26b 100644 --- a/solidworks-api/document/drawing/propagate-configurations-sheets/Macro.vba +++ b/solidworks-api/document/drawing/propagate-configurations-sheets/Macro.vba @@ -1,13 +1,17 @@ -Const TOP_LEVEL_CONFIGS_ONLY As Boolean = False +Const PROCESS_TOP_LEVEL_CONFIGS As Boolean = True +Const PROCESS_CHILDREN_CONFIGS As Boolean = False + Const USE_CORRESPONDING_FLAT_PATTERN_CONF As Boolean = True Const GENERATE_MISSING_FLAT_PATTERN_CONF As Boolean = True +Const FORCE_SINGLE_BODY As Boolean = False + Dim swApp As SldWorks.SldWorks Sub main() Set swApp = Application.SldWorks - + Dim swDraw As SldWorks.DrawingDoc Set swDraw = swApp.ActiveDoc @@ -30,7 +34,7 @@ Sub main() ValidateSheet swSheet, swRefDoc Dim vConfNames As Variant - vConfNames = GetConfigurations(swRefDoc) + vConfNames = GetConfigurations(swRefDoc, GetActualReferencedConfiguration(swDefView)) Dim i As Integer @@ -59,7 +63,7 @@ Sub main() End Sub -Function GetConfigurations(refDoc As SldWorks.ModelDoc2) As Variant +Function GetConfigurations(refDoc As SldWorks.ModelDoc2, confToExclude As String) As Variant Dim confNames() As String @@ -73,18 +77,25 @@ Function GetConfigurations(refDoc As SldWorks.ModelDoc2) As Variant Dim confName As String confName = CStr(vConfNames(i)) - Dim swConf As SldWorks.Configuration - Set swConf = refDoc.GetConfigurationByName(confName) + If LCase(confName) <> LCase(confToExclude) Then - If (Not TOP_LEVEL_CONFIGS_ONLY Or swConf.GetParent() Is Nothing) And swConf.Type = swConfigurationType_e.swConfiguration_Standard Then + Dim swConf As SldWorks.Configuration + Set swConf = refDoc.GetConfigurationByName(confName) + + If swConf.Type = swConfigurationType_e.swConfiguration_Standard Then + + If (PROCESS_TOP_LEVEL_CONFIGS And swConf.GetParent() Is Nothing) Or (PROCESS_CHILDREN_CONFIGS And Not swConf.GetParent() Is Nothing) Then + If (Not confNames) = -1 Then + ReDim confNames(0) + Else + ReDim Preserve confNames(UBound(confNames) + 1) + End If - If (Not confNames) = -1 Then - ReDim confNames(0) - Else - ReDim Preserve confNames(UBound(confNames) + 1) - End If + confNames(UBound(confNames)) = confName + + End If - confNames(UBound(confNames)) = confName + End If End If @@ -186,13 +197,17 @@ Sub CopySheetWithConfiguration(draw As SldWorks.DrawingDoc, sheet As SldWorks.sh Dim confName As String If False <> swView.IsFlatPatternView() And USE_CORRESPONDING_FLAT_PATTERN_CONF Then - confName = GetFlatPatternConfiguration(draw, swView.ReferencedDocument, baseConfName, GENERATE_MISSING_FLAT_PATTERN_CONF) + confName = GetFlatPatternConfiguration(draw, swView, baseConfName, GENERATE_MISSING_FLAT_PATTERN_CONF) Else confName = baseConfName End If swView.ReferencedConfiguration = confName + If FORCE_SINGLE_BODY Then + SetSingleBody swView + End If + RefreshView draw, swView Next @@ -246,10 +261,14 @@ Sub RefreshView(draw As SldWorks.DrawingDoc, swView As SldWorks.view) End Sub -Function GetFlatPatternConfiguration(draw As SldWorks.DrawingDoc, refDoc As SldWorks.ModelDoc2, baseConfName As String, allowCreateIfNotExist As Boolean) As String +Function GetFlatPatternConfiguration(draw As SldWorks.DrawingDoc, view As SldWorks.view, baseConfName As String, allowCreateIfNotExist As Boolean) As String + Dim swRefDoc As SldWorks.ModelDoc2 + + Set swRefDoc = view.ReferencedDocument + Dim swConf As SldWorks.Configuration - Set swConf = refDoc.GetConfigurationByName(baseConfName) + Set swConf = swRefDoc.GetConfigurationByName(baseConfName) If swConf.Type <> swConfigurationType_e.swConfiguration_SheetMetal Then @@ -278,7 +297,7 @@ Function GetFlatPatternConfiguration(draw As SldWorks.DrawingDoc, refDoc As SldW If allowCreateIfNotExist Then Debug.Print "Creating flat pattern configuration for " & baseConfName - GetFlatPatternConfiguration = CreateFlatPatternConfiguration(draw, refDoc, baseConfName) + GetFlatPatternConfiguration = CreateFlatPatternConfiguration(draw, view, baseConfName) Else Debug.Print "Flat pattern configuration is not found for " & baseConfName GetFlatPatternConfiguration = baseConfName @@ -289,28 +308,37 @@ Function GetFlatPatternConfiguration(draw As SldWorks.DrawingDoc, refDoc As SldW End Function -Function CreateFlatPatternConfiguration(draw As SldWorks.DrawingDoc, refDoc As SldWorks.ModelDoc2, baseConfName As String) As String +Function CreateFlatPatternConfiguration(draw As SldWorks.DrawingDoc, view As SldWorks.view, baseConfName As String) As String - Dim swFlatPatternView As SldWorks.view - Set swFlatPatternView = draw.CreateFlatPatternViewFromModelView3(refDoc.GetPathName(), baseConfName, 0, 0, 0, True, False) + view.ReferencedConfiguration = baseConfName - If Not swFlatPatternView Is Nothing Then - CreateFlatPatternConfiguration = swFlatPatternView.ReferencedConfiguration - - If SelectDrawingView(draw, swFlatPatternView) Then - If False = draw.Extension.DeleteSelection2(swDeleteSelectionOptions_e.swDelete_Absorbed) Then - Err.Raise vbError, "", "Failed to delete temp view" - End If + SetSingleBody view + + If SelectDrawingView(draw, view) Then + If False <> draw.ChangeRefConfigurationOfFlatPatternView(view.ReferencedDocument.GetPathName(), view.ReferencedConfiguration) Then + CreateFlatPatternConfiguration = view.ReferencedConfiguration Else - Err.Raise vbError, "", "Failed to select temp view for deletion" + Err.Raise vbError, "", "Failed to create flat pattern view for " & view.ReferencedDocument.GetPathName() & " (" & baseConfName & ")" End If - Else - Err.Raise vbError, "", "Failed to create temp flat pattern view for " & refDoc.GetPathName() & " (" & baseConfName & ")" + Err.Raise vbError, "", "Failed to select temp view for deletion" End If - + End Function +Sub SetSingleBody(view As SldWorks.view) + + Dim vViewBodies As Variant + vViewBodies = view.Bodies + + If Not IsEmpty(vViewBodies) Then + Dim swBody(0) As SldWorks.Body2 + Set swBody(0) = vViewBodies(0) + view.Bodies = swBody + End If + +End Sub + Function SelectDrawingView(draw As SldWorks.ModelDoc2, view As SldWorks.view) As Boolean SelectDrawingView = False <> draw.Extension.SelectByID2(view.Name, "DRAWINGVIEW", 0, 0, 0, False, -1, Nothing, swSelectOption_e.swSelectOptionDefault) End Function diff --git a/solidworks-api/document/drawing/propagate-configurations-sheets/confs-to-sheets.svg b/solidworks-api/document/drawing/propagate-configurations-sheets/confs-to-sheets.svg new file mode 100644 index 00000000..bd7b40f5 --- /dev/null +++ b/solidworks-api/document/drawing/propagate-configurations-sheets/confs-to-sheets.svg @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/solidworks-api/document/drawing/propagate-configurations-sheets/index.md b/solidworks-api/document/drawing/propagate-configurations-sheets/index.md index f57d12f0..74499bf2 100644 --- a/solidworks-api/document/drawing/propagate-configurations-sheets/index.md +++ b/solidworks-api/document/drawing/propagate-configurations-sheets/index.md @@ -2,7 +2,7 @@ caption: Propagate Configurations To Sheets title: Macro propagates configurations of the referenced document to sheets in the SOLIDWORKS drawings description: VBA macro copies the input sheet and sets the referenced configuration sof the referenced document -image: sheets.png +image: confs-to-sheets.svg --- ![Drawings with multiple sheets](sheets.png){ width=800 } @@ -18,9 +18,13 @@ As the result drawing will contain sheets for all the configurations of the mult Macro can be configured by changing the constant values of the macro ~~~ vb -Const TOP_LEVEL_CONFIGS_ONLY As Boolean = False 'True to only process top level configurations, False to process children configurations -Const USE_CORRESPONDING_FLAT_PATTERN_CONF As Boolean = True 'True to find the corresponding SM-FLAT-PATTERN configuration for the flat pattern view, False to use configuration As Is +Const PROCESS_TOP_LEVEL_CONFIGS As Boolean = True 'True to process top level configurations +Const PROCESS_CHILDREN_CONFIGS As Boolean = False 'True to process children configurations + +Const USE_CORRESPONDING_FLAT_PATTERN_CONF As Boolean = True'True to find the corresponding SM-FLAT-PATTERN configuration for the flat pattern view, False to use configuration As Is Const GENERATE_MISSING_FLAT_PATTERN_CONF As Boolean = True 'True to automatically create new SM-FLAT-PATTERN configuration if not exist, False to use configuration As Is + +Const FORCE_SINGLE_BODY As Boolean = False 'True to select single body for multi-body configurations (can be useful for the cut-list configurations) ~~~ ## Notes diff --git a/solidworks-api/document/features-manager/defeature-part/Macro.vba b/solidworks-api/document/features-manager/defeature-part/Macro.vba index 7b6cc472..e40812b8 100644 --- a/solidworks-api/document/features-manager/defeature-part/Macro.vba +++ b/solidworks-api/document/features-manager/defeature-part/Macro.vba @@ -4,83 +4,118 @@ Sub main() Set swApp = Application.SldWorks +try_: + + On Error GoTo catch_ + Dim swPart As SldWorks.PartDoc Set swPart = swApp.ActiveDoc If Not swPart Is Nothing Then - Dim vBodies As Variant - vBodies = GetBodyCopies(swPart) + Dim vUserFeats As Variant + vUserFeats = GetAllTopLevelUserFeatures(swPart) - DeleteAllUserFeatures swPart - - CreateFeaturesForBodies swPart, vBodies + If Not IsEmpty(vUserFeats) Then + CreateFeaturesForBodies swPart + DeleteFeatures swPart, vUserFeats + Else + Err.Raise vbError, "", "No features in the model" + End If Else MsgBox "Please open part document" End If + GoTo finally_ + +catch_: + MsgBox Err.Description, vbCritical +finally_: + End Sub -Function GetBodyCopies(part As SldWorks.PartDoc) As Variant +Sub CreateFeaturesForBodies(part As SldWorks.PartDoc) Dim vBodies As Variant - - vBodies = part.GetBodies2(swBodyType_e.swAllBodies, True) - Dim i As Integer - For i = 0 To UBound(vBodies) + vBodies = part.GetBodies2(swBodyType_e.swAllBodies, False) + + If Not IsEmpty(vBodies) Then + + Dim i As Integer - Dim swBody As SldWorks.Body2 - Set swBody = vBodies(i) - Set swBody = swBody.Copy() - Set vBodies(i) = swBody + For i = 0 To UBound(vBodies) + + Dim swBody As SldWorks.Body2 + Set swBody = vBodies(i) + Set swBodyCopy = swBody.Copy() + + Dim swFeat As SldWorks.Feature - Next - - GetBodyCopies = vBodies - -End Function - -Sub CreateFeaturesForBodies(part As SldWorks.PartDoc, vBodies As Variant) - - Dim i As Integer + Set swFeat = part.CreateFeatureFromBody3(swBodyCopy, False, swCreateFeatureBodyOpts_e.swCreateFeatureBodySimplify) + + If Not swFeat Is Nothing Then + + Dim swFace As SldWorks.Face2 + Set swFace = swFeat.GetFaces()(0) + + Dim swReplacedBody As SldWorks.Body2 + Set swReplacedBody = swFace.GetBody + + swReplacedBody.HideBody False = swBody.Visible + + Else + Err.Raise vbError, "", "Failed to create feature for a body " & swBody.Name + End If + + Next - For i = 0 To UBound(vBodies) - Dim swBody As SldWorks.Body2 - Set swBody = vBodies(i) - part.CreateFeatureFromBody3 swBody, False, swCreateFeatureBodyOpts_e.swCreateFeatureBodySimplify - Next + Else + + Err.Raise vbError, "", "No bodies found" + + End If End Sub -Sub DeleteAllUserFeatures(model As SldWorks.ModelDoc2) +Sub DeleteFeatures(model As SldWorks.ModelDoc2, feats As Variant) - SelectAllTopLevelUserFeatures model - - model.Extension.DeleteSelection2 swDeleteSelectionOptions_e.swDelete_Children + swDeleteSelectionOptions_e.swDelete_Absorbed + If model.Extension.MultiSelect2(feats, False, Nothing) = UBound(feats) + 1 Then + model.Extension.DeleteSelection2 swDeleteSelectionOptions_e.swDelete_Children + swDeleteSelectionOptions_e.swDelete_Absorbed + Else + Err.Raise vbError, "", "Failed to select user features" + End If End Sub -Sub SelectAllTopLevelUserFeatures(model As SldWorks.ModelDoc2) +Function GetAllTopLevelUserFeatures(model As SldWorks.ModelDoc2) As Variant - model.ClearSelection2 True + Dim swUserFeats() As SldWorks.Feature Dim swFeat As SldWorks.Feature Set swFeat = model.FirstFeature - Dim selectFeat As Boolean - selectFeat = False + Dim isUserFeat As Boolean + isUserFeat = False While Not swFeat Is Nothing - If selectFeat Then - swFeat.Select2 True, -1 + If isUserFeat Then + + If (Not swUserFeats) = -1 Then + ReDim swUserFeats(0) + Else + ReDim Preserve swUserFeats(UBound(swUserFeats) + 1) + End If + + Set swUserFeats(UBound(swUserFeats)) = swFeat + Else If swFeat.GetTypeName2() = "OriginProfileFeature" Then - selectFeat = True + isUserFeat = True End If End If @@ -88,4 +123,10 @@ Sub SelectAllTopLevelUserFeatures(model As SldWorks.ModelDoc2) Wend -End Sub \ No newline at end of file + If (Not swUserFeats) = -1 Then + GetAllTopLevelUserFeatures = Empty + Else + GetAllTopLevelUserFeatures = swUserFeats + End If + +End Function \ No newline at end of file diff --git a/solidworks-api/document/features-manager/defeature-part/index.md b/solidworks-api/document/features-manager/defeature-part/index.md index 4c709319..ecef424f 100644 --- a/solidworks-api/document/features-manager/defeature-part/index.md +++ b/solidworks-api/document/features-manager/defeature-part/index.md @@ -5,9 +5,9 @@ description: Macro to convert all features in part to dumb solids (defeature par image: part-feature-tree-defeatured.png labels: [defeature,parasolid] --- -This macro emulates the functionality of [Defeature for Part](https://help.solidworks.com/2018/english/solidworks/sldworks/c_defeature_for_parts.htm) but not using it directly. +This VBA macro defeatures the active SOLIDWORKS part. Unlike the [Defeature for Part](https://help.solidworks.com/2018/english/solidworks/sldworks/c_defeature_for_parts.htm) functionality, this macro preserves the original geometry and does not simplify it. -Macro copies all visible solid and surface bodies, deletes all user features and imports the copied bodies using SOLIDWORKS API. +Macro copies all solid and surface bodies, deletes all user features and imports the copied bodies using SOLIDWORKS API. Macro will preserve the hidden flag from the original bodies. **Before:** diff --git a/solidworks-api/document/features-manager/hide-features/index.md b/solidworks-api/document/features-manager/hide-features/index.md index 96cdd7e8..91c63cb4 100644 --- a/solidworks-api/document/features-manager/hide-features/index.md +++ b/solidworks-api/document/features-manager/hide-features/index.md @@ -5,7 +5,7 @@ description: VBA macro which hides features and makes them invisible in the SOLI image: hidden-features.png labels: [feature,hide,invisible] --- -This VBA macro allows to make invisible selected features in the tree. The features still continue to be fully operational and visible in the graphics area (e.g. planes), but not visible in the feature manager tree. +This VBA macro allows to make selected features invisible in the tree. The features still continue to be fully operational and visible in the graphics area (e.g. planes), but not visible in the feature manager tree. Even default features (such as planes) can be made invisible. diff --git a/solidworks-api/document/notes/get-note-format-text/Macro.vba b/solidworks-api/document/notes/get-note-format-text/Macro.vba new file mode 100644 index 00000000..5941c69f --- /dev/null +++ b/solidworks-api/document/notes/get-note-format-text/Macro.vba @@ -0,0 +1,46 @@ +Dim swApp As SldWorks.SldWorks + +Sub main() + + Set swApp = Application.SldWorks + + Dim swModel As SldWorks.ModelDoc2 + + Set swModel = swApp.ActiveDoc + + If Not swModel Is Nothing Then + + Dim swSelMgr As SldWorks.SelectionMgr + + Set swSelMgr = swModel.SelectionManager + + Dim swNote As SldWorks.Note + + Set swNote = swSelMgr.GetSelectedObject6(1, -1) + + If Not swNote Is Nothing Then + Dim prpLinkedText As String + prpLinkedText = swNote.PropertyLinkedText + SetClipboard prpLinkedText + Debug.Print prpLinkedText + Else + Err.Raise vbError, "", "Select note" + End If + + Else + Err.Raise vbError, "", "Open the model" + End If + +End Sub + +Sub SetClipboard(text As String) + + Dim vText As Variant + vText = text + + Dim htmlFile As Object + Set htmlFile = CreateObject("htmlfile") + + htmlFile.parentWindow.clipboardData.SetData "text", vText + +End Sub \ No newline at end of file diff --git a/solidworks-api/document/notes/get-note-format-text/index.md b/solidworks-api/document/notes/get-note-format-text/index.md new file mode 100644 index 00000000..1dea4a0a --- /dev/null +++ b/solidworks-api/document/notes/get-note-format-text/index.md @@ -0,0 +1,15 @@ +--- +caption: Get Note Text Format +title: VBA macro to get formatting text form the selected SOLIDWORKS note +description: VBA macro puts the formatted note text (including the font parameters, size and color) from the selected note in the SOLIDWORKS document into the clipboard +image: note-format-text.png +--- +![Formatted note text](note-format-text.png){ width=800 } + +This VBA macro copies the value of formatted text from the selected note in SOLIDWORKS part, assembly or drawing and copies the value to the clipboard. + +Formatted note text includes font information (size, style, color), align, paragraph properties, etc. + +![Note formatting](note-formatting.png){ width=800 } + +{% code-snippet { file-name: Macro.vba } %} \ No newline at end of file diff --git a/solidworks-api/document/notes/get-note-format-text/note-format-text.png b/solidworks-api/document/notes/get-note-format-text/note-format-text.png new file mode 100644 index 00000000..3d18b0ed Binary files /dev/null and b/solidworks-api/document/notes/get-note-format-text/note-format-text.png differ diff --git a/solidworks-api/document/notes/get-note-format-text/note-formatting.png b/solidworks-api/document/notes/get-note-format-text/note-formatting.png new file mode 100644 index 00000000..cf38fdef Binary files /dev/null and b/solidworks-api/document/notes/get-note-format-text/note-formatting.png differ diff --git a/solidworks-api/document/save-as-previous-version/Macro.vba b/solidworks-api/document/save-as-previous-version/Macro.vba new file mode 100644 index 00000000..5cf74d19 --- /dev/null +++ b/solidworks-api/document/save-as-previous-version/Macro.vba @@ -0,0 +1,111 @@ +Const SW_VERSION As Integer = -1 'save into previous version + +Const PREFIX As String = "" +Const SUFFIX As String = "_PREV" + +Dim swApp As SldWorks.SldWorks + +Sub main() + + Set swApp = Application.SldWorks + + Dim swModel As SldWorks.ModelDoc2 + + Set swModel = swApp.ActiveDoc + + If Not swModel Is Nothing Then + + Dim swAdvancedSaveAsOpts As SldWorks.AdvancedSaveAsOptions + + Set swAdvancedSaveAsOpts = swModel.Extension.GetAdvancedSaveAsOptions(swSaveWithReferencesOptions_e.swSaveWithReferencesOptions_None) + + swAdvancedSaveAsOpts.SaveAsPreviousVersion = GetVersionNumber(SW_VERSION) + swAdvancedSaveAsOpts.SaveAllAsCopy = True + + Dim vIds As Variant + Dim vNames As Variant + Dim vPaths As Variant + + swAdvancedSaveAsOpts.GetItemsNameAndPath vIds, vNames, vPaths + + Dim i As Integer + + For i = 0 To UBound(vNames) + vNames(i) = ComposeName(CStr(vNames(i))) + Next + + swAdvancedSaveAsOpts.ModifyItemsNameAndPath vIds, vNames, vPaths + + Dim errs As Long + Dim warns As Long + + Dim path As String + path = swModel.GetPathName + + If path <> "" Then + + Dim dir As String + + dir = GetDirectory(path) + + Dim fileName As String + + fileName = ComposeName(GetFileName(path)) + + If False = swModel.Extension.SaveAs3(dir & fileName, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, swAdvancedSaveAsOpts, errs, warns) Then + Err.Raise vbError, "", "Failed to save model: " & errs + End If + + Else + Err.Raise vbError, "", "Active model is never saved" + End If + + Else + Err.Raise vbError, "", "Open model" + End If + +End Sub + +Function GetVersionNumber(swVers As Integer) As Integer + + Dim revNmb As Integer + revNmb = CInt(Split(swApp.RevisionNumber, ".")(0)) + + Const SW_2022_REVISION As Integer = 30 + Const SW_2022_VERSION As Integer = 15000 + Const SW_VERSION_STEP As Integer = 1000 + + Dim versOffset As Integer + + versOffset = revNmb + swVers - SW_2022_REVISION + + If versOffset >= 0 Then + GetVersionNumber = SW_2022_VERSION + SW_VERSION_STEP * versOffset + Else + Err.Raise vbError, "", "Minimum supported version is SOLIDWORKS 2022" + End If + +End Function + +Function ComposeName(fileName As String) As String + + Dim ext As String + ext = Right(fileName, Len(".SLDXXX")) + + ComposeName = PREFIX & Left(fileName, Len(fileName) - Len(ext)) & SUFFIX & ext + +End Function + +Function GetFileName(path As String) As String + + Dim fileName As String + + fileName = Right(path, Len(path) - InStrRev(path, "\")) + + GetFileName = fileName + +End Function + +Function GetDirectory(path As String) + GetDirectory = Left(path, InStrRev(path, "\")) +End Function \ No newline at end of file diff --git a/solidworks-api/document/save-as-previous-version/index.md b/solidworks-api/document/save-as-previous-version/index.md new file mode 100644 index 00000000..eef4f807 --- /dev/null +++ b/solidworks-api/document/save-as-previous-version/index.md @@ -0,0 +1,26 @@ +--- +caption: Save As Previous Versions +title: VBA macro to save active file into the previous version of SOLIDWORKS +description: VBA macro to save the active SOLIDWORKS document into previous version with optional suffix and prefix +--- + +This VBA macro allows to save the active SOLIDWORKS document into previous versions of SOLIDWORKS. + +User can specify the version to save to via **SW_VERSION** constant in the macro. This number is an offset of the version relative to the current version of SOLIDWORKS. + +For example: + +* If **-1** is specified for **SOLIDWORKS 2024**, then the file will be saved as **SOLIDWORKS 2023** +* If **-2** is specified for **SOLIDWORKS 2024** then the file will be saved in **SOLIDWORKS 2022** +* If **-1** is specified for **SOLIDWORKS 2025**, then the file will be saved as **SOLIDWORKS 2024** + +User can specify suffix and prefix in the **PREFIX** and **SUFFIX** constants. Suffix will be applied to all references (in case assembly or drawing is saved) + +~~~ vb +Const SW_VERSION As Integer = -1 'save into previous version + +Const PREFIX As String = "" 'no prefix +Const SUFFIX As String = "_PREV" 'suffix is added to all references +~~~ + +{% code-snippet { file-name: Macro.vba } %} \ No newline at end of file diff --git a/solidworks-api/document/selection/select-standard-ref-geometry/Macro.vba b/solidworks-api/document/selection/select-standard-ref-geometry/Macro.vba index 84449dfc..8f26768a 100644 --- a/solidworks-api/document/selection/select-standard-ref-geometry/Macro.vba +++ b/solidworks-api/document/selection/select-standard-ref-geometry/Macro.vba @@ -1,4 +1,5 @@ -#Const ARGS = False +#Const ARGS = True +#Const TEST = FALSE Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Const VK_CONTROL As Long = &H11 @@ -25,17 +26,18 @@ Sub main() Set swModel = swApp.ActiveDoc #If ARGS Then - Dim macroRunner As Object - Set macroRunner = CreateObject("CadPlus.MacroRunner.Sw") - Dim param As Object - Set param = macroRunner.PopParameter(swApp) + Dim macroOper As Object + Set macroOper = GetMacroOperation() Dim vArgs As Variant - vArgs = param.Get("Args") + vArgs = macroOper.Arguments + + Dim arg As Object + Set arg = vArgs(0) Dim planeName As String - planeName = CStr(vArgs(0)) + planeName = arg.GetValue() Select Case UCase(planeName) Case "ORIGIN" @@ -46,6 +48,8 @@ Sub main() REF_GEOM = swRefGeom_e.Front Case "RIGHT" REF_GEOM = swRefGeom_e.Right + Case Else + Err.Raise vbError, "", "Not supported argument" End Select #Else REF_GEOM = swRefGeom_e.Top @@ -69,10 +73,10 @@ Sub main() End If Else - MsgBox "Only assemblies and parts are supported" + Err.Raise vbError, "", "Only assemblies and parts are supported" End If Else - MsgBox "Please open part or assembly" + Err.Raise vbError, "", "Please open part or assembly" End If End Sub @@ -135,4 +139,28 @@ Sub SelectOrigin(origFeat As SldWorks.Feature, append As Boolean) swSkPoint.Select4 append, Nothing -End Sub \ No newline at end of file +End Sub + +Function GetMacroOperation(Optional dummy As Variant = Empty) As Object + + Dim macroOper As Object + + #If TEST Then + Dim swCadPlusFact As Object + Set swCadPlusFact = CreateObject("CadPlusFactory.Sw") + + Set swCadPlus = swCadPlusFact.Create(swApp, False) + + Dim ARGS(0) As String + ARGS(0) = "FRONT" + Set macroOper = swCadPlus.CreateMacroOperation(swApp.ActiveDoc, "", ARGS) + #Else + Dim macroOprMgr As Object + Set macroOprMgr = CreateObject("CadPlus.MacroOperationManager") + + Set macroOper = macroOprMgr.PopOperation(swApp) + #End If + + Set GetMacroOperation = macroOper + +End Function \ No newline at end of file diff --git a/solidworks-api/document/selection/select-standard-ref-geometry/index.md b/solidworks-api/document/selection/select-standard-ref-geometry/index.md index 53068eba..9e588426 100644 --- a/solidworks-api/document/selection/select-standard-ref-geometry/index.md +++ b/solidworks-api/document/selection/select-standard-ref-geometry/index.md @@ -6,6 +6,7 @@ description: Example demonstrates how to select standard plane (Top, Front or Ri image: plane.svg labels: [selection, plane, origin] group: Model +macro-plus: vba redirect-from: - /solidworks-api/document/selection/select-standard-plane/ --- diff --git a/solidworks-api/document/set-bom-quantity-unit-of-measure-property/Macro.vba b/solidworks-api/document/set-bom-quantity-unit-of-measure-property/Macro.vba index 5e635b3e..e770446d 100644 --- a/solidworks-api/document/set-bom-quantity-unit-of-measure-property/Macro.vba +++ b/solidworks-api/document/set-bom-quantity-unit-of-measure-property/Macro.vba @@ -1,6 +1,8 @@ Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 +Const SET_CONFIGURATIONS As Boolean = False + Const BOM_QTY_PRP_NAME As String = "UNIT_OF_MEASURE" Const QTY_PRP_NAME As String = "Qty" @@ -16,13 +18,26 @@ Sub main() Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("") - Dim bomQtyPrp As String - swCustPrpMgr.Get3 BOM_QTY_PRP_NAME, False, "", bomQtyPrp - - Debug.Print bomQtyPrp + SetQtyCustomProperty swCustPrpMgr - swCustPrpMgr.Add2 BOM_QTY_PRP_NAME, swCustomInfoType_e.swCustomInfoText, QTY_PRP_NAME - swCustPrpMgr.Set2 BOM_QTY_PRP_NAME, QTY_PRP_NAME + If SET_CONFIGURATIONS Then + + Dim vConfNames As Variant + vConfNames = swModel.GetConfigurationNames + + If Not IsEmpty(vConfNames) Then + + Dim i As Integer + + For i = 0 To UBound(vConfNames) + Dim swConfCustPrpMgr As SldWorks.CustomPropertyManager + Set swConfCustPrpMgr = swModel.Extension.CustomPropertyManager(CStr(vConfNames(i))) + SetQtyCustomProperty swConfCustPrpMgr + Next + + End If + + End If Else @@ -30,4 +45,16 @@ Sub main() End If +End Sub + +Sub SetQtyCustomProperty(custPrpMgr As SldWorks.CustomPropertyManager) + + Dim bomQtyPrp As String + custPrpMgr.Get3 BOM_QTY_PRP_NAME, False, "", bomQtyPrp + + Debug.Print bomQtyPrp + + custPrpMgr.Add2 BOM_QTY_PRP_NAME, swCustomInfoType_e.swCustomInfoText, QTY_PRP_NAME + custPrpMgr.Set2 BOM_QTY_PRP_NAME, QTY_PRP_NAME + End Sub \ No newline at end of file diff --git a/solidworks-api/document/set-bom-quantity-unit-of-measure-property/index.md b/solidworks-api/document/set-bom-quantity-unit-of-measure-property/index.md index f4ba890d..dad8940e 100644 --- a/solidworks-api/document/set-bom-quantity-unit-of-measure-property/index.md +++ b/solidworks-api/document/set-bom-quantity-unit-of-measure-property/index.md @@ -17,4 +17,10 @@ This option allows overwriting the quantity value of the component in the BOM ta In order to change this property it is required to set the hidden *UNIT_OF_MEASURE* custom property via [ICustomPropertyManager](https://help.solidworks.com/2018/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.icustompropertymanager.html) SOLIDWORKS API interface. +In order to set BOM quantity for all configurations set the **SET_CONFIGURATIONS** constant to **True** + +~~~ vb +Const SET_CONFIGURATIONS As Boolean = True +~~~ + {% code-snippet { file-name: Macro.vba } %} diff --git a/solidworks-api/document/sheet-metal/create-multi-body-flat-pattern/Macro.vba b/solidworks-api/document/sheet-metal/create-multi-body-flat-pattern/Macro.vba new file mode 100644 index 00000000..8d550d1e --- /dev/null +++ b/solidworks-api/document/sheet-metal/create-multi-body-flat-pattern/Macro.vba @@ -0,0 +1,43 @@ +Dim swApp As SldWorks.SldWorks + +Sub main() + + Set swApp = Application.SldWorks + + Dim swModel As SldWorks.ModelDoc2 + + Set swModel = swApp.ActiveDoc + + If Not swModel Is Nothing Then + + Dim swSelMgr As SldWorks.SelectionMgr + + Set swSelMgr = swModel.SelectionManager + + Dim swBody As SldWorks.Body2 + + Set swBody = swSelMgr.GetSelectedObject6(1, -1) + + If Not swBody Is Nothing Then + + swBody.Select2 False, Nothing + + Dim templatePath As String + templatePath = swApp.GetDocumentTemplate(swDocumentTypes_e.swDocDRAWING, "", swDwgPaperSizes_e.swDwgPaperA4size, 0, 0) + + Dim swDraw As SldWorks.DrawingDoc + Set swDraw = swApp.NewDocument(templatePath, swDwgPaperSizes_e.swDwgPaperA4size, 0, 0) + + Dim swView As SldWorks.View + + Set swView = swDraw.CreateFlatPatternViewFromModelView3(swModel.GetPathName(), "", 0, 0, 0, False, False) + + Else + Err.Raise vbError, "", "Body is not selected" + End If + + Else + Err.Raise vbError, "", "Open part document" + End If + +End Sub diff --git a/solidworks-api/document/sheet-metal/create-multi-body-flat-pattern/index.md b/solidworks-api/document/sheet-metal/create-multi-body-flat-pattern/index.md new file mode 100644 index 00000000..25697b61 --- /dev/null +++ b/solidworks-api/document/sheet-metal/create-multi-body-flat-pattern/index.md @@ -0,0 +1,11 @@ +--- +caption: Create Multi-Body Flat Pattern View +title: VBA macro to create flat pattern drawing view form the multi-body sheet metal part +description: VBA macro demonstrates how to create flat pattern drawing view of the multi-body sheet metal part using SOLIDWORKS API +--- + +This VBA example demonstrates how to create flat pattern view of a selected body from the multi-body sheet metal part. + +When performing this operation manually from SOLIDWORKS, it is required to insert a drawing view of the full part, then select the single sheet metal body and set the view to **Flat Pattern**. In order to produce similar result from the API, different steps need to be performed. It is required to select the body from the visible source document before calling the [IDrawingDoc::CreateFlatPatternViewFromModelView3](https://help.solidworks.com/2013/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.idrawingdoc~createflatpatternviewfrommodelview3.html) API method. + +{% code-snippet { file-name: Macro.vba } %} \ No newline at end of file diff --git a/solidworks-api/document/sheet-metal/remove-flat-pattern-configuration/Macro.vba b/solidworks-api/document/sheet-metal/remove-flat-pattern-configuration/Macro.vba new file mode 100644 index 00000000..68b59367 --- /dev/null +++ b/solidworks-api/document/sheet-metal/remove-flat-pattern-configuration/Macro.vba @@ -0,0 +1,82 @@ +#Const MACRO_PLUS = True + +Dim swApp As SldWorks.SldWorks + +Sub main() + + Set swApp = Application.SldWorks + Dim swModel As SldWorks.ModelDoc2 + + Dim macroOper As Object + +#If MACRO_PLUS Then + + Dim operMgr As Object + Set operMgr = CreateObject("CadPlus.MacroOperationManager") + + Set macroOper = operMgr.PopOperation(swApp) + + Set swModel = macroOper.Model + +#Else + Set swModel = swApp.ActiveDoc +#End If + + Dim vConfNames As Variant + + vConfNames = swModel.GetConfigurationNames + + Dim hasSmConfs As Boolean + Dim deletedConfsList As String + + If Not IsEmpty(vConfNames) Then + + Dim i As Integer + + For i = 0 To UBound(vConfNames) + + Dim confName As String + confName = CStr(vConfNames(i)) + + Dim swConf As SldWorks.Configuration + Set swConf = swModel.GetConfigurationByName(confName) + + If swConf.Type = swConfigurationType_e.swConfiguration_SheetMetal Then + + hasSmConfs = True + + If False <> swModel.DeleteConfiguration2(swConf.Name) Then + + If deletedConfsList <> "" Then + deletedConfsList = deletedConfsList & vbLf + End If + + deletedConfsList = deletedConfsList & swConf.Name + + Else + #If MACRO_PLUS Then + macroOper.ReportIssue "Failed to delete configuration '" & confName & "'", 2 + macroOper.SetStatus 4 + #End If + End If + + End If + + Next + + End If + +#If MACRO_PLUS Then + If hasSmConfs Then + If deletedConfsList <> "" Then + macroOper.SetResult deletedConfsList + Else + macroOper.SetStatus 2 + End If + Else + macroOper.ReportIssue "No sheet metal configurations found", 1 + macroOper.SetStatus 4 + End If +#End If + +End Sub \ No newline at end of file diff --git a/solidworks-api/document/sheet-metal/remove-flat-pattern-configuration/index.md b/solidworks-api/document/sheet-metal/remove-flat-pattern-configuration/index.md new file mode 100644 index 00000000..9b3553ec --- /dev/null +++ b/solidworks-api/document/sheet-metal/remove-flat-pattern-configuration/index.md @@ -0,0 +1,13 @@ +--- +caption: Remove Flat Pattern Configurations +title: Remove flat pattern configurations (SM-FLAT-PATTERN) from SOLIDWORKS parts +description: VBA macro deletes derived SM-FLAT-PATTERN configurations of the sheet metal SOLIDWORKS parts using SOLIDWORKS API +image: +macro-plus: vba +--- + +This VBA macro deletes all **\SM-FLAT-PATTERN** configurations from SOLIDWORKS part file + +This configuration is created automatically when flat pattern drawing view is created for the sheet metal parts. In some cases this configuration may produce incorrect flat pattern geometry (e.g. missing the unbending). IN order to fix the issue it might be required to remove this configuration and recreate a drawing view. + +{% code-snippet { file-name: Macro.vba } %} \ No newline at end of file diff --git a/solidworks-api/geometry/body-interference/Macro.vba b/solidworks-api/geometry/body-interference/Macro.vba new file mode 100644 index 00000000..1f45288a --- /dev/null +++ b/solidworks-api/geometry/body-interference/Macro.vba @@ -0,0 +1,58 @@ +Dim swApp As SldWorks.SldWorks + +Sub main() + + Set swApp = Application.SldWorks + + Dim swModel As SldWorks.ModelDoc2 + + Set swModel = swApp.ActiveDoc + + Dim swSelMgr As SldWorks.SelectionMgr + + Set swSelMgr = swModel.SelectionManager + + Dim swBody1 As SldWorks.Body2 + Dim swBody2 As SldWorks.Body2 + + Set swBody1 = swSelMgr.GetSelectedObject6(1, -1) + Set swBody2 = swSelMgr.GetSelectedObject6(2, -1) + + If Not swBody1 Is Nothing And Not swBody2 Is Nothing Then + + Set swBody1 = swBody1.Copy2(False) + Set swBody2 = swBody2.Copy2(False) + + Dim swModeler As SldWorks.Modeler + + Set swModeler = swApp.GetModeler + + Dim vBody1Faces As Variant + Dim vBody2Faces As Variant + + Dim vIntersectBodies As Variant + + If False <> swModeler.CheckInterferenceBetweenTwoBodies(swBody1, swBody2, True, vBody1Faces, vBody2Faces, vIntersectBodies) Then + + Dim i As Integer + + For i = 0 To UBound(vIntersectBodies) + Dim swIntersectBody As SldWorks.Body2 + Set swIntersectBody = vIntersectBodies(i) + swIntersectBody.Display3 swModel, RGB(255, 255, 0), swTempBodySelectOptions_e.swTempBodySelectOptionNone + Next + + Stop + + For i = 0 To UBound(vIntersectBodies) + Set vIntersectBodies(i) = Nothing + Next + Else + Debug.Print "No Interferences" + End If + + Else + Err.Raise vbError, "", "Select 2 bodies" + End If + +End Sub \ No newline at end of file diff --git a/solidworks-api/geometry/body-interference/body-collision-volume.png b/solidworks-api/geometry/body-interference/body-collision-volume.png new file mode 100644 index 00000000..ddecf78c Binary files /dev/null and b/solidworks-api/geometry/body-interference/body-collision-volume.png differ diff --git a/solidworks-api/geometry/body-interference/index.md b/solidworks-api/geometry/body-interference/index.md new file mode 100644 index 00000000..c2d1d398 --- /dev/null +++ b/solidworks-api/geometry/body-interference/index.md @@ -0,0 +1,12 @@ +--- +caption: Find Collision Between Two Bodies +title: VBA macro to find and preview collision volume between two selected bodies +description: VBA macro to check the interference and preview the collision volume between two bodies +image: body-collision-volume.png +--- + +This VBA macro finds the collision volume between two selected bodies and display the temp preview. + +![Body collision preview](body-collision-volume.png){ width=600 } + +{% code-snippet { file-name: Macro.vba } %} \ No newline at end of file diff --git a/solidworks-api/geometry/extend-surface/Macro.vba b/solidworks-api/geometry/extend-surface/Macro.vba new file mode 100644 index 00000000..050abe06 --- /dev/null +++ b/solidworks-api/geometry/extend-surface/Macro.vba @@ -0,0 +1,55 @@ +Enum ExtendSurfaceEndCondition_e + Distance = 0 + UpToVertex = 1 + UpToFace = 2 +End Enum + +Const EXTEND_DISTANCE As Double = 0.01 + +Dim swApp As SldWorks.SldWorks + +Sub main() + + Set swApp = Application.SldWorks + + Dim swModel As SldWorks.ModelDoc2 + Dim swSelMgr As SldWorks.SelectionMgr + + Set swModel = swApp.ActiveDoc + + If Not swModel Is Nothing Then + + Set swSelMgr = swModel.SelectionManager + + Dim swFace As SldWorks.Face2 + Set swFace = swSelMgr.GetSelectedObject6(1, -1) + + If Not swFace Is Nothing Then + + Dim swBody As SldWorks.Body2 + + Set swBody = swFace.CreateSheetBody + + Dim vEdges As Variant + vEdges = swBody.GetEdges + + Dim swExtendedBody As SldWorks.Body2 + Set swExtendedBody = swBody.ExtendSurface(vEdges, True, ExtendSurfaceEndCondition_e.Distance, EXTEND_DISTANCE, Nothing, Nothing) + + If Not swExtendedBody Is Nothing Then + swExtendedBody.Display2 swModel, RGB(255, 255, 0), swTempBodySelectOptions_e.swTempBodySelectOptionNone + Stop + Set swExtendedBody = Nothing + Else + Err.Raise vbError, "", "Failed to extend the selected face" + End If + + Else + Err.Raise vbError, "", "Select face to extend" + End If + + Else + Err.Raise vbError, "", "Open part document" + End If + +End Sub \ No newline at end of file diff --git a/solidworks-api/geometry/extend-surface/extended-planar-surface.png b/solidworks-api/geometry/extend-surface/extended-planar-surface.png new file mode 100644 index 00000000..d3dd6dfd Binary files /dev/null and b/solidworks-api/geometry/extend-surface/extended-planar-surface.png differ diff --git a/solidworks-api/geometry/extend-surface/index.md b/solidworks-api/geometry/extend-surface/index.md new file mode 100644 index 00000000..f055152f --- /dev/null +++ b/solidworks-api/geometry/extend-surface/index.md @@ -0,0 +1,15 @@ +--- +caption: Extend Surface +title: VBA macro to extend selected face using SOLIDWORKS API +description: VBA macro example which demonstrates how to extend the selected face with the specified distance and display the preview as temp body +image: extended-planar-surface.png +--- + +This VBA macro demonstrates how to create a temp body preview of the extended surface based on the face selected in the graphics area + +Macro will stop execution and display the preview. Preview is hidden when macro completes + +![Preview of the extended face](extended-planar-surface.png){ width=400 } + +{% code-snippet { file-name: Macro.vba } %} + diff --git a/solidworks-api/geometry/get-total-face-area/Macro.vba b/solidworks-api/geometry/get-total-face-area/Macro.vba new file mode 100644 index 00000000..a4cc32af --- /dev/null +++ b/solidworks-api/geometry/get-total-face-area/Macro.vba @@ -0,0 +1,63 @@ +Const VISIBLE_ONLY As Boolean = True + +Dim swApp As SldWorks.SldWorks + +Sub main() + + Set swApp = Application.SldWorks + + Dim swPart As SldWorks.PartDoc + + Set swPart = swApp.ActiveDoc + + If Not swPart Is Nothing Then + + Dim vBodies As Variant + + vBodies = swPart.GetBodies2(swBodyType_e.swAllBodies, VISIBLE_ONLY) + + Dim totalArea As Double + + If Not IsEmpty(vBodies) Then + + Dim i As Integer + + For i = 0 To UBound(vBodies) + + Dim swBody As SldWorks.Body2 + + Set swBody = vBodies(i) + Dim vFaces As Variant + + vFaces = swBody.GetFaces + + If Not IsEmpty(vFaces) Then + Dim j As Integer + + For j = 0 To UBound(vFaces) + Dim swFace As SldWorks.Face2 + Set swFace = vFaces(j) + totalArea = totalArea + swFace.GetArea + Next + + End If + + Next + + Dim swUserUnit As SldWorks.UserUnit + Set swUserUnit = swPart.GetUserUnit(swUserUnitsType_e.swLengthUnit) + + Dim convFactor As Double + convFactor = swUserUnit.GetConversionFactor() ^ 2 + + MsgBox "Total Area: " & totalArea * convFactor & " " & swUserUnit.GetUnitsString(False) & "^2" + + Else + Err.Raise vbError, "", "No bodies" + End If + + Else + Err.Raise vbError, "", "Open part file" + End If + +End Sub \ No newline at end of file diff --git a/solidworks-api/geometry/get-total-face-area/index.md b/solidworks-api/geometry/get-total-face-area/index.md new file mode 100644 index 00000000..9bffa55f --- /dev/null +++ b/solidworks-api/geometry/get-total-face-area/index.md @@ -0,0 +1,11 @@ +--- +caption: Get Total Face Area +title: VBA macro to get total face area of the part file +description: VBA macro to calculate total face area of all faces from all bodies (including surface bodies) and display in the user units +--- + +This VBA macro finds the total area of all faces of all bodies (optionally only visible bodies) in the active part file. Macro will consider both solid and surface bodies. + +Results is displayed in the message box in the user units. + +{% code-snippet { file-name: Macro.vba } %} \ No newline at end of file diff --git a/solidworks-api/getting-started/scripts/vbscript/batch-export/export-sw-models.vbs b/solidworks-api/getting-started/scripts/vbscript/batch-export/export-sw-models.vbs index 5f10fb57..53d5950c 100644 --- a/solidworks-api/getting-started/scripts/vbscript/batch-export/export-sw-models.vbs +++ b/solidworks-api/getting-started/scripts/vbscript/batch-export/export-sw-models.vbs @@ -10,6 +10,8 @@ outDir = WScript.Arguments.Item(2) Dim outExt outExt = WScript.Arguments.Item(3) +WScript.Echo "Connecting to SOLIDWORKS" + Dim swApp Set swApp = CreateObject("SldWorks.Application") swApp.Visible = True @@ -24,6 +26,8 @@ dim file For Each file in folder.Files If LCase(fso.GetExtensionName(file.Path)) = LCase(filter) Then + + WScript.Echo "Opening " & file.Path Dim docSpec Set docSpec = swApp.GetOpenDocSpec(file.Path) docSpec.ReadOnly = True @@ -34,6 +38,7 @@ For Each file in folder.Files If Not swModel is Nothing Then Dim outFilePath outFilePath = outDir & "\" & fso.GetBaseName(file) & "." & outExt + WScript.Echo "Exporting " & file.Path & " to " & outFilePath swModel.SaveAs outFilePath swApp.CloseDoc swModel.GetTitle() End If diff --git a/solidworks-api/getting-started/scripts/vbscript/batch-export/index.md b/solidworks-api/getting-started/scripts/vbscript/batch-export/index.md index 16931ebd..b27aa547 100644 --- a/solidworks-api/getting-started/scripts/vbscript/batch-export/index.md +++ b/solidworks-api/getting-started/scripts/vbscript/batch-export/index.md @@ -5,6 +5,8 @@ description: Example of batch exporting SOLIDWORKS documents from the vbScript --- This example of vbScript which demonstrates how to batch export SOLIDWORKS documents using vbScript +Use **csript** to run the scrip in order to print log messages to console, instead of the message boxes + ## Arguments 1. Path to folder with SOLIDWORKS models @@ -13,7 +15,7 @@ This example of vbScript which demonstrates how to batch export SOLIDWORKS docum 1. Extension of the output format ~~~ -> "export-sw-models.vbs" "C:\Models" sldprt "C:\Output" step +> csript "export-sw-models.vbs" "C:\Models" sldprt "C:\Output" step ~~~ {% code-snippet { file-name: export-sw-models.vbs } %} \ No newline at end of file diff --git a/solidworks-api/getting-started/stand-alone/index.md b/solidworks-api/getting-started/stand-alone/index.md index d70c97a4..593fb76e 100644 --- a/solidworks-api/getting-started/stand-alone/index.md +++ b/solidworks-api/getting-started/stand-alone/index.md @@ -61,6 +61,8 @@ SOLIDWORKS 2019|27 SOLIDWORKS 2020|28 SOLIDWORKS 2021|29 SOLIDWORKS 2022|30 +SOLIDWORKS 2023|31 +SOLIDWORKS 2024|32 It is possible to get the revision number of SOLIDWORKS session via [ISldWorks::RevisionNumber](https://help.solidworks.com/2012/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.isldworks~revisionnumber.html) method. The returned value is a string in the format: **25.1.0** where first number is a revision number. diff --git a/solidworks-api/import-export/dwg-export-cleanup/index.md b/solidworks-api/import-export/dwg-export-cleanup/index.md index 7ffa3888..5c16a08c 100644 --- a/solidworks-api/import-export/dwg-export-cleanup/index.md +++ b/solidworks-api/import-export/dwg-export-cleanup/index.md @@ -11,7 +11,7 @@ labels: [dxf,dwg,cleanup,flat pattern,export] The code below provides a workaround for this issue. -> Not this code doesn't allow to set the settings of the export (default options are used). It is required to use Windows API to modify the options and check boxes. +> Note this code doesn't allow to set the settings of the export (default options are used). It is required to use Windows API to modify the options and check boxes. ## Configuration diff --git a/solidworks-api/import-export/export-individual-bodies/CustomVariableValueProvider.vba b/solidworks-api/import-export/export-individual-bodies/CustomVariableValueProvider.vba new file mode 100644 index 00000000..bc0d3912 --- /dev/null +++ b/solidworks-api/import-export/export-individual-bodies/CustomVariableValueProvider.vba @@ -0,0 +1,17 @@ +Option Explicit + +Implements IMacroCustomVariableValueProvider + +Function IMacroCustomVariableValueProvider_Provide(ByVal varName As String, ByVal args As Variant, ByVal context As Variant) As Variant + + Dim swBody As SldWorks.Body2 + Set swBody = context + + Select Case varName + Case "bodyName": + IMacroCustomVariableValueProvider_Provide = swBody.Name + Case Else + Err.Raise vbError, "", "Not supported variable: " & varName + End Select + +End Function \ No newline at end of file diff --git a/solidworks-api/import-export/export-individual-bodies/Macro.vba b/solidworks-api/import-export/export-individual-bodies/Macro.vba new file mode 100644 index 00000000..c0c60365 --- /dev/null +++ b/solidworks-api/import-export/export-individual-bodies/Macro.vba @@ -0,0 +1,223 @@ +'#Const TEST = True + +Dim swApp As SldWorks.SldWorks +Dim swCadPlus As ICadPlusSwAddIn + +Sub main() + + Set swApp = Application.SldWorks + + Dim swCadPlusFact As CadPlusSwAddInFactory + Set swCadPlusFact = New CadPlusSwAddInFactory + + Set swCadPlus = swCadPlusFact.Create(swApp, True) + + Dim macroOper As IMacroOperation + Set macroOper = GetMacroOperation() + + Dim vArgs As Variant + vArgs = macroOper.Arguments + + Dim swModel As SldWorks.ModelDoc2 + Set swModel = macroOper.model + + Dim swPart As SldWorks.PartDoc + + Set swPart = swModel + + Dim vBodies As Variant + vBodies = swPart.GetBodies2(swBodyType_e.swAllBodies, True) + + Dim i As Integer + Dim swBody As SldWorks.Body2 + + Dim customVarValProv As IMacroCustomVariableValueProvider + Set customVarValProv = New CustomVariableValueProvider + + Dim resFilePaths() As String + Dim inputBodies() As SldWorks.Body2 + + For i = 0 To UBound(vBodies) + + Set swBody = vBodies(i) + + Dim j As Integer + + For j = 0 To UBound(vArgs) + + Dim macroArg As IMacroArgument + Set macroArg = vArgs(j) + + Dim fileName As String + fileName = macroArg.GetValue(customVarValProv, swBody) + + Dim filePath As String + filePath = GetDirectory(swModel.GetPathName) & fileName + + If (Not resFilePaths) = -1 Then + ReDim resFilePaths(0) + ReDim inputBodies(0) + Else + ReDim Preserve resFilePaths(UBound(resFilePaths) + 1) + ReDim Preserve inputBodies(UBound(inputBodies) + 1) + End If + + resFilePaths(UBound(resFilePaths)) = filePath + Set inputBodies(UBound(inputBodies)) = swBody + + Next + + Next + + Dim vResFiles As Variant + vResFiles = macroOper.SetResultFiles(resFilePaths) + + For i = 0 To UBound(vResFiles) + + Dim resFile As IMacroOperationResultFile + Set resFile = vResFiles(i) + Set swBody = inputBodies(i) + + Dim ext As String + ext = GetExtension(resFile.path) + + If LCase(ext) = "dxf" Or LCase(ext) = "dwg" Then + If False <> swBody.IsSheetMetal() Then + TryExportFlatPattern swModel, swBody, resFile, macroOper + Else + resFile.Status = MacroOperationResultFileStatus_e_Initializing + macroOper.ReportIssue "Flat pattern export is skipped for " & swBody.Name, MacroIssueType_e_Information + End If + Else + TryExportBody swModel, swBody, resFile, macroOper + End If + + Next + +End Sub + +Sub TryExportBody(model As SldWorks.ModelDoc2, body As SldWorks.Body2, resFile As IMacroOperationResultFile, macroOper As MacroOperation) + +try_: + On Error GoTo catch_ + + Dim swSelMgr As SldWorks.SelectionMgr + Set swSelMgr = model.SelectionManager + + swSelMgr.SuspendSelectionList + + Dim swBodies(0) As SldWorks.Body2 + Set swBodies(0) = body + + If swSelMgr.AddSelectionListObjects(swBodies, Nothing) = 1 Then + + Dim filePath As String + filePath = resFile.path + + Dim errs As Long + Dim warns As Long + Dim dir As String + + dir = GetDirectory(filePath) + + CreateDirectories dir + + If False <> model.Extension.SaveAs2(filePath, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, "", False, errs, warns) Then + resFile.Status = MacroOperationResultFileStatus_e_Succeeded + Else + Err.Raise vbError, "", "Failed to export '" & body.Name & "' to '" & filePath & "'. Error code: " & errs + End If + Else + Err.Raise vbError, "", "Failed to select " & body.Name + End If + + GoTo finally_ +catch_: + macroOper.ReportIssue Err.Description, MacroIssueType_e_Error + resFile.Status = MacroOperationResultFileStatus_e_Failed +finally_: + + swSelMgr.ResumeSelectionList2 False + +End Sub + +Sub TryExportFlatPattern(model As SldWorks.ModelDoc2, body As SldWorks.Body2, resFile As IMacroOperationResultFile, macroOper As MacroOperation) + +try_: + On Error GoTo catch_ + + Dim expData(0) As FlatPatternExportDataCom + Set expData(0) = New FlatPatternExportDataCom + + Set expData(0).body = body + expData(0).Options = FlatPatternOptionsCom_e.FlatPatternOptionsCom_e_BendLines + expData(0).OutFilePath = resFile.path + + Dim vRes As Variant + vRes = swCadPlus.FlatPatternExport.BatchExportFlatPatterns(model, expData) + + Dim res As FlatPatternExportResult + Set res = vRes(0) + + If False = res.Succeeded Then + Err.Raise vbError, "", res.Error + End If + + resFile.Status = MacroOperationResultFileStatus_e_Succeeded + + GoTo finally_ +catch_: + macroOper.ReportIssue Err.Description, MacroIssueType_e_Error + resFile.Status = MacroOperationResultFileStatus_e_Failed +finally_: + +End Sub + +Function GetMacroOperation() As IMacroOperation + + Dim macroOper As IMacroOperation + + #If TEST Then + Dim swCadPlusFact As Object + Set swCadPlusFact = CreateObject("CadPlusFactory.Sw") + + Set swCadPlus = swCadPlusFact.Create(swApp, False) + + Dim args(2) As String + args(0) = "MFGs\STEP\{ path [FileNameWithoutExtension] }-{ bodyName }.step" + args(1) = "MFGs\IGES\{ path [FileNameWithoutExtension] }-{ bodyName }.igs" + args(2) = "MFGs\DWG\{ path [FileNameWithoutExtension] }-{ bodyName }.dwg" + Set macroOper = swCadPlus.CreateMacroOperation(swApp.ActiveDoc, "", args) + #Else + Dim macroOprMgr As IMacroOperationManager + Set macroOprMgr = CreateObject("CadPlus.MacroOperationManager") + + Set macroOper = macroOprMgr.PopOperation(swApp) + #End If + + Set GetMacroOperation = macroOper + +End Function + +Function GetExtension(path As String) As String + GetExtension = Right(path, Len(path) - InStrRev(path, ".")) +End Function + +Function GetDirectory(path As String) + GetDirectory = Left(path, InStrRev(path, "\")) +End Function + +Sub CreateDirectories(path As String) + + Dim fso As Object + Set fso = CreateObject("Scripting.FileSystemObject") + + If fso.FolderExists(path) Then + Exit Sub + End If + + CreateDirectories fso.GetParentFolderName(path) + + fso.CreateFolder path + +End Sub \ No newline at end of file diff --git a/solidworks-api/import-export/export-individual-bodies/export-body.svg b/solidworks-api/import-export/export-individual-bodies/export-body.svg new file mode 100644 index 00000000..0627dbff --- /dev/null +++ b/solidworks-api/import-export/export-individual-bodies/export-body.svg @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/solidworks-api/import-export/export-individual-bodies/index.md b/solidworks-api/import-export/export-individual-bodies/index.md new file mode 100644 index 00000000..ed46cb2e --- /dev/null +++ b/solidworks-api/import-export/export-individual-bodies/index.md @@ -0,0 +1,19 @@ +--- +caption: Export Individual Bodies +title: Export individual bodies and flat-patterns from SOLIDWORKS part file via Macro+ framework +description: VBA macro demonstrates how to use Macro+ and CAD+ API to export individual bodies to foreign format and flat pattern (for sheet metal) from the active SOLIDWORKS part +image: export-body.svg +macro-plus: vba +--- + +This VBA macro is [Macro+](https://cadplus.xarial.com/macro-plus/) enabled macro that allows exporting all bodies in the active part file as individual files to foreign format (e.g. STEP, IGES, Parasolid etc.). + +Sheet metal bodies could be exported to DXF/DWG format as flat pattern via [Flat Pattern Export](https://cadplus.xarial.com/drawing/export-flat-patterns/) tool API of [CAD+ Toolset](https://cadplus.xarial.com/) + +This macro supports the custom argument **bodyName** and it will be resolved to the corresponding body name. + +{% code-snippet { file-name: Macro.vba } %} + +## CustomVariableValueProvider Class Module + +{% code-snippet { file-name: CustomVariableValueProvider.vba } %} \ No newline at end of file diff --git a/solidworks-api/import-export/export-individual-cut-lists/CustomVariableValueProvider.vba b/solidworks-api/import-export/export-individual-cut-lists/CustomVariableValueProvider.vba new file mode 100644 index 00000000..6144fd03 --- /dev/null +++ b/solidworks-api/import-export/export-individual-cut-lists/CustomVariableValueProvider.vba @@ -0,0 +1,23 @@ +Option Explicit + +Implements IMacroCustomVariableValueProvider + +Function IMacroCustomVariableValueProvider_Provide(ByVal varName As String, ByVal args As Variant, ByVal context As Variant) As Variant + + Dim swCutList As SldWorks.Feature + Set swCutList = context + + Select Case varName + Case "cutListPrp": + Dim prpName As String + prpName = CStr(args(0)) + Dim swCustPrpsMgr As SldWorks.CustomPropertyManager + Set swCustPrpsMgr = swCutList.CustomPropertyManager + Dim prpVal As String + swCustPrpsMgr.Get5 prpName, False, "", prpVal, False + IMacroCustomVariableValueProvider_Provide = prpVal + Case Else + Err.Raise vbError, "", "Not supported variable: " & varName + End Select + +End Function \ No newline at end of file diff --git a/solidworks-api/import-export/export-individual-cut-lists/Macro.vba b/solidworks-api/import-export/export-individual-cut-lists/Macro.vba new file mode 100644 index 00000000..48cba523 --- /dev/null +++ b/solidworks-api/import-export/export-individual-cut-lists/Macro.vba @@ -0,0 +1,303 @@ +'#Const TEST = True + +Dim swApp As SldWorks.SldWorks + +Sub main() + + Set swApp = Application.SldWorks + + Dim macroOper As IMacroOperation + Set macroOper = GetMacroOperation() + + Dim vArgs As Variant + vArgs = macroOper.Arguments + + Dim swModel As SldWorks.ModelDoc2 + Set swModel = macroOper.model + + If Not swModel Is Nothing Then + + If swModel.GetType() = swDocumentTypes_e.swDocPART Then + + Dim swPart As SldWorks.PartDoc + + Set swPart = swModel + + Dim vCutLists As Variant + vCutLists = GetCutLists(swPart) + + Dim i As Integer + Dim swBody As SldWorks.Body2 + + Dim customVarValProv As IMacroCustomVariableValueProvider + Set customVarValProv = New CustomVariableValueProvider + + Dim resFilePaths() As String + Dim inputBodies() As SldWorks.Body2 + + For i = 0 To UBound(vCutLists) + + Dim swCutList As SldWorks.Feature + Set swCutList = vCutLists(i) + + Dim j As Integer + + For j = 0 To UBound(vArgs) + + Dim macroArg As IMacroArgument + Set macroArg = vArgs(j) + + Dim fileName As String + fileName = macroArg.GetValue(customVarValProv, swCutList) + + Dim filePath As String + filePath = GetDirectory(swModel.GetPathName) & fileName + + If (Not resFilePaths) = -1 Then + ReDim resFilePaths(0) + ReDim inputBodies(0) + Else + ReDim Preserve resFilePaths(UBound(resFilePaths) + 1) + ReDim Preserve inputBodies(UBound(inputBodies) + 1) + End If + + Dim swBodyFolder As SldWorks.BodyFolder + Set swBodyFolder = swCutList.GetSpecificFeature2 + + If swBodyFolder.GetBodyCount() > 0 Then + Set swBody = swBodyFolder.GetBodies()(0) + Else + Set swBody = Nothing + End If + + resFilePaths(UBound(resFilePaths)) = filePath + Set inputBodies(UBound(inputBodies)) = swBody + + Next + + Next + + Dim vResFiles As Variant + vResFiles = macroOper.SetResultFiles(resFilePaths) + + For i = 0 To UBound(vResFiles) + + Dim resFile As IMacroOperationResultFile + Set resFile = vResFiles(i) + Set swBody = inputBodies(i) + + Dim ext As String + ext = GetExtension(resFile.path) + + TryExportBody swModel, swBody, resFile, macroOper + + Next + + Else + Err.Raise vbError, "", "Only parts are supported" + End If + + Else + Err.Raise vbError, "", "Open model" + End If + +End Sub + +Sub TryExportBody(model As SldWorks.ModelDoc2, body As SldWorks.Body2, resFile As IMacroOperationResultFile, macroOper As MacroOperation) + +try_: + On Error GoTo catch_ + + Dim swSelMgr As SldWorks.SelectionMgr + Set swSelMgr = model.SelectionManager + + swSelMgr.SuspendSelectionList + + Dim swBodies(0) As SldWorks.Body2 + Set swBodies(0) = body + + If swSelMgr.AddSelectionListObjects(swBodies, Nothing) = 1 Then + + Dim filePath As String + filePath = resFile.path + + Dim errs As Long + Dim warns As Long + Dim dir As String + + dir = GetDirectory(filePath) + + CreateDirectories dir + + If False <> model.Extension.SaveAs2(filePath, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, "", False, errs, warns) Then + resFile.Status = MacroOperationResultFileStatus_e_Succeeded + Else + Err.Raise vbError, "", "Failed to export '" & body.Name & "' to '" & filePath & "'. Error code: " & errs + End If + Else + Err.Raise vbError, "", "Failed to select " & body.Name + End If + + GoTo finally_ +catch_: + macroOper.ReportIssue Err.Description, MacroIssueType_e_Error + resFile.Status = MacroOperationResultFileStatus_e_Failed +finally_: + + swSelMgr.ResumeSelectionList2 False + +End Sub + +Sub TryExportFlatPattern(model As SldWorks.ModelDoc2, body As SldWorks.Body2, resFile As IMacroOperationResultFile, macroOper As MacroOperation) + +try_: + On Error GoTo catch_ + + Dim expData(0) As FlatPatternExportDataCom + Set expData(0) = New FlatPatternExportDataCom + + Set expData(0).body = body + expData(0).Options = FlatPatternOptionsCom_e.FlatPatternOptionsCom_e_BendLines + expData(0).OutFilePath = resFile.path + + Dim vRes As Variant + vRes = swCadPlus.FlatPatternExport.BatchExportFlatPatterns(model, expData) + + Dim res As FlatPatternExportResult + Set res = vRes(0) + + If False = res.Succeeded Then + Err.Raise vbError, "", res.Error + End If + + resFile.Status = MacroOperationResultFileStatus_e_Succeeded + + GoTo finally_ +catch_: + macroOper.ReportIssue Err.Description, MacroIssueType_e_Error + resFile.Status = MacroOperationResultFileStatus_e_Failed +finally_: + +End Sub + +Function GetMacroOperation(Optional dummy As Variant = Empty) As IMacroOperation + + Dim macroOper As IMacroOperation + + #If TEST Then + Dim swCadPlusFact As Object + Set swCadPlusFact = CreateObject("CadPlusFactory.Sw") + + Set swCadPlus = swCadPlusFact.Create(swApp, False) + + Dim args(1) As String + args(0) = "MFGs\STEP\{ path [FileNameWithoutExtension] }-{ cutListPrp [Description] }.step" + Set macroOper = swCadPlus.CreateMacroOperation(swApp.ActiveDoc, "", args) + #Else + Dim macroOprMgr As IMacroOperationManager + Set macroOprMgr = CreateObject("CadPlus.MacroOperationManager") + + Set macroOper = macroOprMgr.PopOperation(swApp) + #End If + + Set GetMacroOperation = macroOper + +End Function + +Function GetExtension(path As String) As String + GetExtension = Right(path, Len(path) - InStrRev(path, ".")) +End Function + +Function GetDirectory(path As String) + GetDirectory = Left(path, InStrRev(path, "\")) +End Function + +Sub CreateDirectories(path As String) + + Dim fso As Object + Set fso = CreateObject("Scripting.FileSystemObject") + + If fso.FolderExists(path) Then + Exit Sub + End If + + CreateDirectories fso.GetParentFolderName(path) + + fso.CreateFolder path + +End Sub + +Function GetCutLists(part As SldWorks.PartDoc) As Variant + + Dim swFeat As SldWorks.Feature + + Dim swCutLists() As SldWorks.Feature + + Set swFeat = part.FirstFeature + + While Not swFeat Is Nothing + + If swFeat.GetTypeName2 <> "HistoryFolder" Then + + ProcessFeature swFeat, swCutLists + + TraverseSubFeatures swFeat, swCutLists + + End If + + Set swFeat = swFeat.GetNextFeature + + Wend + + GetCutLists = swCutLists + +End Function + +Sub TraverseSubFeatures(parentFeat As SldWorks.Feature, cutLists() As SldWorks.Feature) + + Dim swChildFeat As SldWorks.Feature + Set swChildFeat = parentFeat.GetFirstSubFeature + + While Not swChildFeat Is Nothing + ProcessFeature swChildFeat, cutLists + Set swChildFeat = swChildFeat.GetNextSubFeature() + Wend + +End Sub + +Sub ProcessFeature(feat As SldWorks.Feature, cutLists() As SldWorks.Feature) + + If feat.GetTypeName2() = "SolidBodyFolder" Then + Dim swBodyFolder As SldWorks.BodyFolder + Set swBodyFolder = feat.GetSpecificFeature2 + swBodyFolder.UpdateCutList + ElseIf feat.GetTypeName2() = "CutListFolder" Then + + If Not Contains(cutLists, feat) Then + If (Not cutLists) = -1 Then + ReDim cutLists(0) + Else + ReDim Preserve cutLists(UBound(cutLists) + 1) + End If + + Set cutLists(UBound(cutLists)) = feat + End If + + End If + +End Sub + +Function Contains(arr As Variant, item As Object) As Boolean + + Dim i As Integer + + For i = 0 To UBound(arr) + If arr(i) Is item Then + Contains = True + Exit Function + End If + Next + + Contains = False + +End Function \ No newline at end of file diff --git a/solidworks-api/import-export/export-individual-cut-lists/index.md b/solidworks-api/import-export/export-individual-cut-lists/index.md new file mode 100644 index 00000000..826f0103 --- /dev/null +++ b/solidworks-api/import-export/export-individual-cut-lists/index.md @@ -0,0 +1,17 @@ +--- +caption: Export Individual Cut-Lists +title: Export individual bodies from cut-lists from SOLIDWORKS part file via Macro+ framework +description: VBA macro demonstrates how to use Macro+ to export individual bodies from cut-lists to foreign format from the active SOLIDWORKS part +image: +macro-plus: vba +--- + +This VBA macro is [Macro+](https://cadplus.xarial.com/macro-plus/) enabled macro that allows exporting unique bodies from all cut-lists in the active part file as individual files to foreign format (e.g. STEP, IGES, Parasolid etc.). + +This macro supports the custom variable **cutListPrp** with argument for the property name and it will be resolved to the corresponding cut-list custom proeprty value. + +{% code-snippet { file-name: Macro.vba } %} + +## CustomVariableValueProvider Class Module + +{% code-snippet { file-name: CustomVariableValueProvider.vba } %} \ No newline at end of file diff --git a/solidworks-api/import-export/export-multi-formats/Macro.vba b/solidworks-api/import-export/export-multi-formats/Macro.vba index e753bdb2..75868f63 100644 --- a/solidworks-api/import-export/export-multi-formats/Macro.vba +++ b/solidworks-api/import-export/export-multi-formats/Macro.vba @@ -129,7 +129,7 @@ Sub ExportFile(model As SldWorks.ModelDoc2, vOutNameTemplates As Variant, allCon Set swExportData = Nothing End If - If False = model.Extension.SaveAs(outFilePath, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExportData, errs, warns) Then + If False = model.Extension.SaveAs(outFilePath, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent + swSaveAsOptions_e.swSaveAsOptions_Copy, swExportData, errs, warns) Then Err.Raise vberrror, "", "Failed to export to " & outFilePath End If @@ -311,16 +311,18 @@ try_: On Error GoTo catch_ - Dim macroRunner As Object - Set macroRunner = CreateObject("CadPlus.MacroRunner.Sw") - - Dim param As Object - Set param = macroRunner.PopParameter(swApp) + Dim macroOprMgr As Object + Set macroOprMgr = CreateObject("CadPlus.MacroOperationManager") + + Set macroOper = macroOprMgr.PopOperation(swApp) Dim vArgs As Variant - vArgs = param.Get("Args") + vArgs = macroOper.Arguments + + Dim macroArg As Object + Set macroArg = vArgs(0) - outDir = CStr(vArgs(0)) + outDir = CStr(macroArg.GetValue()) TryGetOutDirFromArguments = True GoTo finally_ diff --git a/solidworks-api/import-export/export-multi-formats/index.md b/solidworks-api/import-export/export-multi-formats/index.md index 08111d33..0fca01e3 100644 --- a/solidworks-api/import-export/export-multi-formats/index.md +++ b/solidworks-api/import-export/export-multi-formats/index.md @@ -6,6 +6,7 @@ description: VBA macro to export file (or optionally all configuration or drawin image: batch-export.svg labels: [export] group: Import/Export +macro-plus: vba --- ![Save File dialog with the list of supported formats](file-save-dialog.png){ width=500 } diff --git a/solidworks-api/import-export/export/Macro.vba b/solidworks-api/import-export/export/Macro.vba new file mode 100644 index 00000000..70cdc2a1 --- /dev/null +++ b/solidworks-api/import-export/export/Macro.vba @@ -0,0 +1,134 @@ +'#Const TEST = True + +Private Declare PtrSafe Function PathIsRelative Lib "shlwapi" Alias "PathIsRelativeA" (ByVal pszPath As String) As Boolean + +Dim swApp As SldWorks.SldWorks + +Sub main() + + Set swApp = Application.SldWorks + + Dim macroOper As IMacroOperation + Set macroOper = GetMacroOperation() + + Dim vArgs As Variant + vArgs = macroOper.Arguments + + Dim swModel As SldWorks.ModelDoc2 + Set swModel = macroOper.model + + Dim resFilePaths() As String + ReDim resFilePaths(UBound(vArgs)) + + For i = 0 To UBound(vArgs) + + Dim macroArg As IMacroArgument + Set macroArg = vArgs(i) + + Dim filePath As String + filePath = macroArg.GetValue() + + If PathIsRelative(filePath) Then + + Dim modelPath As String + modelPath = swModel.GetPathName + + If modelPath <> "" Then + filePath = GetDirectory(modelPath) & filePath + Else + Err.Raise vbError, "", "Cannot use relative path for an unsaved model" + End If + + End If + + resFilePaths(i) = filePath + + Next + + Dim vResFiles As Variant + vResFiles = macroOper.SetResultFiles(resFilePaths) + + For i = 0 To UBound(vResFiles) + + Dim resFile As IMacroOperationResultFile + Set resFile = vResFiles(i) + + TryExport swModel, resFile, macroOper + + Next + +End Sub + +Sub TryExport(model As SldWorks.ModelDoc2, resFile As IMacroOperationResultFile, macroOper As MacroOperation) + +try_: + On Error GoTo catch_ + + Dim filePath As String + filePath = resFile.path + + Dim errs As Long + Dim warns As Long + Dim dir As String + + dir = GetDirectory(filePath) + + CreateDirectories dir + + If False <> model.Extension.SaveAs2(filePath, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, "", False, errs, warns) Then + resFile.Status = MacroOperationResultFileStatus_e_Succeeded + Else + Err.Raise vbError, "", "Failed to export to '" & filePath & "'. Error code: " & errs + End If + + GoTo finally_ +catch_: + macroOper.ReportIssue Err.Description, MacroIssueType_e_Error + resFile.Status = MacroOperationResultFileStatus_e_Failed +finally_: + +End Sub + +Function GetMacroOperation() As IMacroOperation + + Dim macroOper As IMacroOperation + + #If TEST Then + Dim swCadPlusFact As Object + Set swCadPlusFact = CreateObject("CadPlusFactory.Sw") + + Set swCadPlus = swCadPlusFact.Create(swApp, False) + + Dim args(1) As String + args(0) = "MFGs\STEP\{ path [FileNameWithoutExtension] }.step" + args(1) = "MFGs\IGES\{ path [FileNameWithoutExtension] }.igs" + Set macroOper = swCadPlus.CreateMacroOperation(swApp.ActiveDoc, "", args) + #Else + Dim macroOprMgr As IMacroOperationManager + Set macroOprMgr = CreateObject("CadPlus.MacroOperationManager") + + Set macroOper = macroOprMgr.PopOperation(swApp) + #End If + + Set GetMacroOperation = macroOper + +End Function + +Function GetDirectory(path As String) + GetDirectory = Left(path, InStrRev(path, "\")) +End Function + +Sub CreateDirectories(path As String) + + Dim fso As Object + Set fso = CreateObject("Scripting.FileSystemObject") + + If fso.FolderExists(path) Then + Exit Sub + End If + + CreateDirectories fso.GetParentFolderName(path) + + fso.CreateFolder path + +End Sub \ No newline at end of file diff --git a/solidworks-api/import-export/export/index.md b/solidworks-api/import-export/export/index.md new file mode 100644 index 00000000..a9c5ba72 --- /dev/null +++ b/solidworks-api/import-export/export/index.md @@ -0,0 +1,17 @@ +--- +caption: Export +title: Export SOLIDWORKS files to foreign formats via Macro+ framework +description: VBA macro demonstrates how to use Macro+ and CAD+ API to export SOLIDWORKS files to multiple specified formats +image: +macro-plus: vba +--- + +This VBA macro is [Macro+](https://cadplus.xarial.com/macro-plus/) enabled macro that allows exporting file as to foreign format (e.g. PDF, DWG, STEP, IGES, Parasolid etc.). + +Each argument of the macro should specify the output file path and the extension of the exported file. + +If specified path is relative than the file will be exported relatively to the input file. + +Macro will automatically created directories if needed. + +{% code-snippet { file-name: Macro.vba } %} \ No newline at end of file diff --git a/visual-basic/algorithms/fso/io/write-binary-file/index.md b/visual-basic/algorithms/fso/io/write-binary-file/index.md index 6dbdae8a..12b9046a 100644 --- a/visual-basic/algorithms/fso/io/write-binary-file/index.md +++ b/visual-basic/algorithms/fso/io/write-binary-file/index.md @@ -12,7 +12,7 @@ The below snippet will overwrite the data in the destination binary file Dim arr(5237) As Byte arr(0) = 12: arr(1) = 1: arr(2) = 0 ... -WriteByteArrToFile("C:\MyFolder\MyFile.dat") +WriteByteArrToFile "C:\MyFolder\MyFile.dat", arr() ~~~ Code will automatically create new file if it doesn't exist.