Macro save as DWG but with different map profile

 

Hi, 

I've been using this Save as DWG macro for many years that i've found on the forum back in the days,

I've enabled "don't show mapping on each save" so it's way faster to export the files, the problem is that we have different clients and often i need to go and manually change the map file for each of them.

Do you think is there any way to integrate that in the macro? Like having "Save as DWG with x map" and another as "Save as DWG with y map"

'File Save As PDF & DWG.swp -------------03/18/13

'Description: Macro to save active drawing as PDF and DWG.
'Precondition: Any active drawing to be saved.
'Postcondition: Active drawing will be saved as PDF and DWG in the same location as drawing.

' Please back up your data before use and USE AT OWN RISK

' This macro is provided as is.  No claims, support, refund, safety net, or
' warranties are expressed or implied.  By using this macro and/or its code in
' any way whatsoever, the user and any entities which the user represents,
' agree to hold the authors free of any and all liability.  Free distribution
' and use of this code in other free works is welcome.  If any portion of
' this code is used in other works, credit to the authors must be placed in
' that work within a user viewable location (e.g., macro header).  All other
' forms of distribution (i.e., not free, fee for delivery, etc) are prohibited
' without the expressed written consent by the authors.  Use at your own risk!
' ------------------------------------------------------------------------------
' Written by: Deepak Gupta (http://gupta9665.wordpress.com/)
' -------------------------------------------------------------------------------

Option Explicit

Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swDraw          As SldWorks.DrawingDoc
Dim Filepath        As String
Sub Main()

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

' Check to see if a drawing is loaded.

If swModel Is Nothing Then
swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
' If no model currently loaded, then exit
Exit Sub
End If

If swModel.GetType <> swDocDRAWING Then
swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
' If active file is not drawing, then exit
Exit Sub
End If

Set swDraw = swModel

If swDraw.GetPathName = "" Then
swDraw.Save
End If

Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, ".") - 1)

swDraw.SaveAs (Filepath + ".DWG")

End Sub
 

 

MacrodwgDrawings And DetailingImport export