AnsweredAssumed Answered

Save as dwg with sheet name in filename

Question asked by John Sadler on Feb 23, 2021
Latest reply on Feb 24, 2021 by John Sadler

   I have a macro that saves a drawing sheet to a specific directory, inserting a custom property into the filename. Its also supposed to take the sheet name and insert into the filename, but it inserts "Sheet1" regardless of the sheet name. I have seen macros here that seem to come close to what I want, but I cant find the right code thats error free.

Can someone help me get the sheet name in the filename?

 

Thanks

 

 

Option Compare Text

 

Dim swApp       As SldWorks.SldWorks
Dim swModel     As SldWorks.ModelDoc2
Dim fso         As Scripting.FileSystemObject
Dim vSheetName  As Variant
Dim Value       As String
Dim DWGName     As String
Dim Answer      As String
Dim MyNote      As String
Dim Fileprop    As String
Dim Filepath    As String
Dim FileName    As String

 

 

Sub main()

 

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

 

Filepath = "H:\SHARED FILES\~DWG LIBRARY"
Filepath = Filepath + "\"

 

Fileprop = swModel.CustomInfo("WORK ORDER NO")

 

FileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
FileName = Left(FileName, InStrRev(FileName, ".") - 1)
vSheetName = swModel.GetSheetNames

 

Set fso = New Scripting.FileSystemObject

 

DWGName = Filepath + FileName + " " + vSheetName(i) + " - " + "(" + Fileprop + ")" + ".DWG"

 

  If fso.FileExists(DWGName) Then
 
    MyNote = "This file already exists." & _
    "Would you like to overwrite?"
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo + vbDefaultButton2)
    
      If Answer = vbNo Then

 

        'Code for No button Press
        MsgBox ("Complete")

 

      Else

 

        'Code for Yes button Press
        MsgBox ("BE SURE TO ROLL A REVISION")
      
        swModel.SaveAs (Filepath + FileName + " " + vSheetName(i) + " - " + "(" + Fileprop + ")" + ".DWG")

 

    End If
  Else
        swModel.SaveAs (Filepath + FileName + " " + vSheetName(i) + " - " + "(" + Fileprop + ")" + ".DWG")
        
        'Code for Yes button Press
        MsgBox ("Complete")

 

End If

 

End Sub

Outcomes