Save drawing as DWG in different directory with custom property in file name

Discussion created by John Sadler on Aug 12, 2019
Latest reply on Aug 13, 2019 by John Sadler

Like • Show 0 Likes0
Comment • 4

Hi all,

I have been searching all over to piece together a macro that saves the open drawing as a DWG in a specific folder, while adding the "DESCRIPTION" custom property to the file name.

I started with recording a macro (see below), saving as DWG to the desired directory... then tried adding different code from this forum, but nothing really worked. Any ideas? Thanks

Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

' Zoom To Fit
Part.ViewZoomtofit2
Part.ClearSelection2 True
boolstatus = Part.EditRebuild3()
' Redraw
Part.GraphicsRedraw2
' Zoom to Area
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1
' Zoom to Area
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1
' Zoom To Fit
Part.ViewZoomtofit2
' Redraw
Part.GraphicsRedraw2
' Save As
longstatus = Part.SaveAs3("H:\SHARED FILES\Purchasing\~DWG Library\2451587326.DWG", 0, 0)

End Sub

Outcomes

John Sadler Aug 12, 2019 6:58 PM

Ok, I am able get the custom property into the file name, but I still cant figure out how to save to the appropriate directory.

This is what I have so far:

Dim swApp       As SldWorks.SldWorks
Dim swModel     As SldWorks.ModelDoc2
Dim Fileprop    As String
Dim Filepath    As String
Dim FileName    As String

Sub main()

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

Fileprop = swModel.CustomInfo("DWG")
Filepath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\"))
FileName = Left(swModel.GetTitle, Len(swModel.GetTitle) - 9)

swModel.SaveAs (Filepath + FileName + Fileprop + ".DWG")

End Sub

Actions

Fifi Riri @ John Sadler on Aug 13, 2019 1:13 AM

It's going to be difficult to help you, if you don't tell what is the path of the specific folder and how does it relate to the path of the file and custom properties.

Note: GetTitle shouldn't be used, since it can return either "Part1" or "Part1.sldprt" if the windows parameter "Hide extension of known type" is checked or not.

So you could use instead:

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

Also: for future questions, please click on "Ask a Question" instead of "Start a discussion"

Actions

John Sadler @ Fifi Riri on Aug 13, 2019 11:57 AM

Fifi,

Thanks for the response.

The code you suggested works perfectly.

The drawing directory is "C:\SW_Vault\Parts"

I need the macro to save the DWG's in the directory "H:\SHARED FILES\Purchasing\~DWG Library"

My apologies for posting in the wrong place.

Actions

John Sadler @ Fifi Riri on Aug 13, 2019 12:59 PM

I was able to get the following macro to do exactly what I need:

Dim swApp       As SldWorks.SldWorks
Dim swModel     As SldWorks.ModelDoc2
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\Purchasing\~DWG Library"
Filepath = Filepath + "\"

Fileprop = swModel.CustomInfo("DWG")

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

swModel.SaveAs (Filepath + FileName + Fileprop + ".DWG")

End Sub

Actions

4 Replies

John Sadler Aug 12, 2019 6:58 PM
Ok, I am able get the custom property into the file name, but I still cant figure out how to save to the appropriate directory.
This is what I have so far:

Dim swApp       As SldWorks.SldWorks
Dim swModel     As SldWorks.ModelDoc2
Dim Fileprop    As String
Dim Filepath    As String
Dim FileName    As String

Sub main()

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

Fileprop = swModel.CustomInfo("DWG")
Filepath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\"))
FileName = Left(swModel.GetTitle, Len(swModel.GetTitle) - 9)

swModel.SaveAs (Filepath + FileName + Fileprop + ".DWG")

End Sub
Like • Show 1 Like1
Actions
- Fifi Riri @ John Sadler on Aug 13, 2019 1:13 AM
  It's going to be difficult to help you, if you don't tell what is the path of the specific folder and how does it relate to the path of the file and custom properties.
  
  Note: GetTitle shouldn't be used, since it can return either "Part1" or "Part1.sldprt" if the windows parameter "Hide extension of known type" is checked or not.
  So you could use instead:
  FileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
  FileName = Left(FileName, InStrRev(FileName, ".") - 1)
  
  Also: for future questions, please click on "Ask a Question" instead of "Start a discussion"
  Like • Show 1 Like1
  Actions
  - John Sadler @ Fifi Riri on Aug 13, 2019 11:57 AM
    Fifi,
    Thanks for the response.
    The code you suggested works perfectly.
    The drawing directory is "C:\SW_Vault\Parts"
    I need the macro to save the DWG's in the directory "H:\SHARED FILES\Purchasing\~DWG Library"
    
    My apologies for posting in the wrong place.
    Like • Show 1 Like1
    Actions
  - John Sadler @ Fifi Riri on Aug 13, 2019 12:59 PM
    I was able to get the following macro to do exactly what I need:
    
    Dim swApp       As SldWorks.SldWorks
    Dim swModel     As SldWorks.ModelDoc2
    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\Purchasing\~DWG Library"
    Filepath = Filepath + "\"
    
    Fileprop = swModel.CustomInfo("DWG")
    
    FileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
    FileName = Left(FileName, InStrRev(FileName, ".") - 1)
    
    swModel.SaveAs (Filepath + FileName + Fileprop + ".DWG")
    
    End Sub
    Like • Show 0 Likes0
    Actions

Save drawing as DWG in different directory with custom property in file name

Outcomes

Related Content

Recommended Content