5 Replies Latest reply on Nov 13, 2013 2:44 PM by John Weakley

    VBA save dxf to file directory that does not include selected path

    John Weakley

      I have a problem with this vba I got online, it works but it somehow includes the file path directory inside the saved filename.

      So if a directory is selected called C:\Desktop\123\ then the filename will be saved as "123.filename.dxf"  I don't know how to remove the top folder out of the saved filename.

      Please help.

       

      Thanks,

       

      John

       

      Dim swApp As SldWorks.SldWorks
      Dim swModel As ModelDoc2
      Dim swView As View
      Dim SelMgr As SelectionMgr
      Dim boolstatus As Boolean
      Dim longstatus As Long, longwarnings As Long
      Dim Feature As Object
      Dim blankTemplate As String
      Dim sheetName As String
      Dim templateWidth As Double
      Dim templateHeigh As Double

      Sub main()
      ' ############################
      ' EDIT TO SUIT YOUR OWN NEEDS
      ' ############################
      blankTemplate = "blank a3.slddrt"    ' Location of the template you wish to use for the Profile sheet (Usually a blank one)
      templateWidth = 0.297                ' Width and height of
      templateHeight = 0.21                ' the above template
      sheetName = "DXF"                ' 1:1 Flat pattern sheet name

      Set swApp = Application.SldWorks

      Set swModel = swApp.ActiveDoc
      Set SelMgr = swModel.SelectionManager
      swModel.NewSheet3 sheetName, 12, 12, 1, 1, False, blankTemplate, templateWidth, templateHeight, True
      ' Get path of drawing and rename extension to SLDPRT
      ' get array of dependencies from the active document
      Dim dependencies As Variant
      dependencies = swModel.GetDependencies2(True, False, False)
      Dim partfile As String
      partfile = dependencies(1)
      Set swView = swModel.CreateFlatPatternViewFromModelView3(partfile, "", 0.15, 0.1, 0, True, False)

      Dim swAnn As SldWorks.Annotation

      Set swAnn = swView.GetFirstAnnotation2
      Do While Not Nothing Is swAnn
          swAnn.Visible = swAnnotationHidden
          Set swAnn = swAnn.GetNext2
      Loop

      swModel.ViewZoomtofit2

      'Save As DXF
      If MsgBox("Save as DXF?", vbYesNo) = vbYes Then

           'Save
          Dim savePath As String
          Dim bRet As Boolean
          Dim newfilepath As String
          Dim sfilename As String
          Dim strings As Variant
          Dim strrevname As String

       

          sfilename = swModel.GetTitle
          strings = Split(sfilename, " - ")
          sfilename = strings(0)
          strrevname = swModel.CustomInfo2("", "Revision")

       

          savePath = SelectFolder()
              If Len(savePath) Then
                  'MsgBox savePath
              Else
                  MsgBox "Cancel was pressed"
              End If

          newfilepath = savePath & sfilename & strrevname & ".DXF"
          bRet = swModel.SaveAs(newfilepath)

      End If

      End Sub

      Function SelectFolder() As String
          Dim objShell As New Shell32.Shell
          Dim objFolder As Shell32.Folder
         
          Set objShell = CreateObject("Shell.Application")

      'If you use 16384 instead of 1 on the next line,
      'files are also displayed
          Set objFolder = objShell.BrowseForFolder _
                                  (0, "Please select a folder", 0, 0)
          If Not objFolder Is Nothing Then
              SelectFolder = objFolder.Items.Item.Path
          End If
      End Function