AnsweredAssumed Answered

Macro help

Question asked by Dave Baxter on Dec 5, 2018
Latest reply on Dec 6, 2018 by Dave Baxter

Hopefully I can explain this in a way that makes sense.

 

I have been using a macro to export Sheet Metal Flat patterns from assemblies for a while now and I am trying to tweak the outputs (if possible).

 

Basically I want to export as a PDF also but the view is normally (depending on the part size) larger than the output image. This is obviously the same with the less important but rather handy, 'windows preview' image. I believe what I need is to add a ZoomToFit command to the Macro but programming is not exactly my forte.

 

The macro as it is now is below, can anyone even understand what I mean or even better help me add the command?

 

I have researched this for quite a while now and just cannot find a simple answer.

 

Thanks in advance

     Dave

 

 

 

    Option Explicit

   

    Dim MyCount As Integer

    Dim PartName(0 To 200) As String

 

 

Sub main()

 

 

   Dim swApp                       As SldWorks.SldWorks

   Dim swModel                     As SldWorks.ModelDoc2

   Dim swAssy                      As SldWorks.AssemblyDoc

   Dim swConf                      As SldWorks.Configuration

   Dim swRootComp                  As SldWorks.Component2

   Dim nStart                      As Single

   Dim bRet                        As Boolean

 

 

   Set swApp = Application.SldWorks

   Set swModel = swApp.ActiveDoc

   Set swConf = swModel.GetActiveConfiguration

   Set swRootComp = swConf.GetRootComponent3(True)

  

 

 

 

 

 

   TraverseComponent swRootComp, 1

 

 

 

 

 

End Sub

 

 

Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)

 

On Error Resume Next

 

 

 

Dim vChildComp                  As Variant

 

   Dim swApp                       As SldWorks.SldWorks

   Dim swpart                      As SldWorks.PartDoc

 

   Dim swChildComp                 As SldWorks.Component2

   Dim swConfig                    As SldWorks.Configuration

   Dim swConfMgr                   As SldWorks.ConfigurationManager

   Dim swChildModel                As SldWorks.ModelDoc2

   Dim swOpenModel                 As SldWorks.ModelDoc2

 

   Dim swChildCustPropMngr         As CustomPropertyManager

   Dim swChildModelDocExt          As ModelDocExtension

   Dim swsheetmetal                As SldWorks.SheetMetalFeatureData

   Dim swFeat                      As SldWorks.Feature

   Dim swBody                      As SldWorks.Body2

 

 

   Dim Sheet_metal                 As Boolean

   Dim Boolstatus                  As Boolean

     

   Dim Thickness                   As Double

   Dim conv                        As Double

 

 

   Dim i                           As Long

   Dim loptions                    As Long

   Dim lerrors                     As Long

 

 

   Dim sPadStr                     As String

   Dim FilePath                    As String

   Dim FileName                    As String

   Dim swThkDir                    As String

   Dim swMatDir                    As String

   Dim swCurrent                   As String

   Dim RefCfg                      As String

   Dim ChildConfigName             As String

   Dim sMatName                    As String

   Dim sMatDB                      As String

   Dim exFileName                  As String

 

   Dim Bodies                      As Variant

 

 

   Dim k As Long

 

 

  

 

   vChildComp = swComp.GetChildren

 

 

   For i = 0 To UBound(vChildComp)

       Set swChildComp = vChildComp(i)

     

       'Check to see if current component is suppressed

       If swChildComp.IsSuppressed = False Then GoTo Active Else GoTo Skip

     

Active:

Set swApp = Application.SldWorks

 

 

Set swChildModel = swChildComp.GetModelDoc2

   'Check to see if child component is an Assembly or part

   If (swChildModel.GetType <> swDocPART) Then GoTo Jump 'Skips Subassemby level

 

 

Set swpart = swChildModel 'Applies part commands for current component

 

 

FilePath = Left(swComp.GetPathName, InStrRev(swComp.GetPathName, "\") - 1)

 

FileName = Left(swChildModel.GetTitle, InStrRev(swChildModel.GetTitle, ".") - 1) 'Get title of component

swCurrent = swChildComp.ReferencedConfiguration 'Get current configuration of component

 

 

 

 

 

'exclude same parts

 

 

PartName(MyCount) = swChildModel.GetTitle & swChildComp.ReferencedConfiguration

 

 

 

 

For k = 0 To MyCount

 

 

If MyCount <> k Then

 

 

If PartName(MyCount) = PartName(k) Then

 

 

'part already exists

 

 

GoTo Jump

 

 

End If

End If

 

 

Next k

 

 

If IsEmpty(swpart.GetBodies2(swBodyType_e.swAllBodies, True)) Then

 

 

GoTo Jump

 

 

End If

 

 

 

Bodies = swpart.GetBodies2(swBodyType_e.swAllBodies, True)

 

 

 

 

 

 

Set swBody = Bodies(0)

 

 

   If swBody.IsSheetMetal = 0 Then 'If Body is not sheet metal

 

 

 

 

           GoTo Jump

   End If

 

   If swBody.IsSheetMetal = 1 Then 'If body is sheet metal

 

 

 

 

       GoTo Process

   End If

 

 

Process:

 

 

'Get Part Material

 

 

Set swpart = swChildModel

sMatName = swpart.GetMaterialPropertyName2(swCurrent, sMatDB)

 

 

If sMatName = "" Then sMatName = "DWG files"

 

 

 

 

'Get part Thickness

 

 

Set swFeat = swChildModel.FirstFeature

   While Not swFeat Is Nothing

 

 

   If swFeat.GetTypeName = "SheetMetal" Then

       Set swsheetmetal = swFeat.GetDefinition

     

       Thickness = swsheetmetal.Thickness

     

     

Select Case swChildModel.LengthUnit

     

  Case "0" 'mm

      conv = 1000

     Thickness = Thickness * conv

 

    Case "2" 'm

      conv = 1

     Thickness = Thickness * conv

 

     Case "3" 'inches

      conv = 39.3700787401575

     Thickness = Thickness * conv

 

 

   End Select

  

   End If

 

 

Set swFeat = swFeat.GetNextFeature

             

   Wend

 

swMatDir = FilePath & "\" & sMatName

 

 

 

 

If Dir(swMatDir, vbDirectory) = "" Then MkDir swMatDir

 

 

swThkDir = FilePath & "\" & sMatName & "\" & Thickness

 

 

 

 

If Dir(swThkDir, vbDirectory) = "" Then MkDir swThkDir

 

 

exFileName = FilePath & "\" & sMatName & "\" & Thickness & "\" & FileName & "-" & swCurrent

 

 

 

 

 

 

Set swOpenModel = swApp.ActivateDoc3(swChildModel.GetPathName, True, loptions, lerrors)

 

 

Boolstatus = swChildModel.ShowConfiguration2(swCurrent)

 

 

swChildModel.ExportFlatPatternView exFileName & ".DWG", 1

 

 

swChildModel.ExportFlatPatternView exFileName & ".PDF", 1

 

 

swApp.CloseDoc (swChildModel.GetPathName)

 

MyCount = MyCount + 1

        

GoTo Jump

        

Skip:

 

 

 

 

 

 

Jump:

       TraverseComponent swChildComp, nLevel + 1

          Next i

 

MyCount = 0

 

 

End Sub

Outcomes