Macro to create pdf and dxf files at the right scale

Hello
I'm a novice on the forum and I found a lot of info on macros to automate certain tasks.
However, I have a request that I don't think has been dealt with by anyone so far.
I would like to be able to create dxf exports automatically from a drawing but according to criteria:
1- If there is an unfolded view, the dxf export should be done taking into account the scale of the unfolded view for a conversion to scale 1
2- If there is no unfolded view (simple laser-cut part) then we take into account the scale of the plan and not a specific view.

I don't know if it's possible to do that.
It would also be necessary to be able to save the pdf and dxf files with their revision index in the file name. And the best thing would also be to be able to have the file in which each export is recorded.

Thanks in advance to all the VBA experts on this forum for your help

Hello @ediatta
If you can give more details,
1 How many views in the sheet
2 Manual (automatic) selection of the view to be exported
3 view exports in the same or different workbooks (if multiple views exist in the sheet)
4 If the view is a unfold (or not) with 1/2 scale, the sheet with 1/5 scale, what is the exit scale for each case.
5 revision index is a PRP in the room, in the sheet or in a table,

Hello @Lynkoa15,
Thank you for answering my subject.
So for more details:
1 how many views in the sheet => 1 only, overall it will be a room a plan

2 manual (automatic) selection of the view to be exported => ideally auto selection of the view but maybe it will be easier to manage a manual selection. There will be 2 cases as a general rule, either it is a folded sheet metal and the unfolded view at a different scale from the finished part views, or it is a simple laser cut part and all the views have the same scale which may or may not be identical to that of the sheet. In case 1 the scale to be considered would be the unfolded view and for case 2 it will be the scale of one of the views. On the other hand, it's the drawing that I want to export but not systematically taking into account the scale of the sheet to convert it and have an output scale 1 of my DXF.

3 view export in the same or different workbooks (if several views exist in the sheet) => we should be able to choose the workbook to which we export (via msgbox or other)

4 if the view is a unfold (or not) with 1/2 scale, the sheet with 1/5 scale, what is the output scale for each case => the output scale must always be 1/1

5 revision index is a PRP in the room, in the sheet or in a table => it is a property in the room

Hello;

Wouldn't the simplest thing be for all your views to be in line with the scale of your drawing?
This is especially true if you only have one view per MEP sheet.

This way, all your exports can be converted in 1:1 to DXF format via the Solidworks settings (Exports).

Solidworks exports your data in "Object" space, which should always be at a 1:1 scale. The 2D convention is that only the 'Paper' space accepts a scale factor...
It's all the more practical for taking odds.

Kind regards.

Hello @Maclane,

I imagined doing as you say. However, there are several views on the same sheet and if the dimensions of the room are large, it is still very practical to have differentiated scales.
Example:
A part with several plies can have much lower finished sides than those of the unfolded which can be larger by a factor of 3, 4 or +. And so it's interesting to play on the scale.
The disadvantage is that the unfolded is used for laser cutting and if it is on a different scale than the plan, the dimensions of the dxf export will be wrong. In other words, if the views of the finished part are at a scale of 1/5 and that of the unfolded at 1/10, the export in dxf will convert from the 1/5 scale => the dimensions of the unfolded used for laser cutting will be wrong.
Otherwise the only option would be to take larger and larger plan formats to always have all the views at the same scale... which is rather a shame

@ediatta, does this code solve the ladder part?

'-------------------------------------------------------------------------
Option Explicit
    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swdrawing               As DrawingDoc
    Dim sPathName               As String
    Dim nErrors                 As Long
    Dim nWarnings               As Long
    Dim bRet                    As Boolean

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swdrawing = swModel
    sPathName = swModel.GetPathName
    sPathName = Left(sPathName, Len(sPathName) - 6)
    sPathName = sPathName + "dxf"
    swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputNoScale, 1
    Dim swview As View
    Set swview = swdrawing.GetFirstView
    Set swview = swview.GetNextView
    Do While Not swview Is Nothing
        If swview.IsFlatPatternView Then
            swApp.SetUserPreferenceDoubleValue swDxfOutputScaleFactor, swview.ScaleRatio(1) / swview.ScaleRatio(0)
            Exit Do
        End If
        Set swview = swview.GetNextView
    Loop
    bRet = swModel.Extension.SaveAs(sPathName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings)
    If bRet = False Then
        swApp.SendMsgToUser2 "Problems saving file.", swMbWarning, swMbOk
    End If

End Sub

Hello @Lynkoa15,

Yes, I tested it and it solves the scale problem.
I didn't necessarily understand the code (especially why do we move on to the next view at the beginning of the loop "as long as", don't we risk missing a view?) but anyway it works. Thank you very much.
All I have to do now is be able to say from the same code that if the unfolded view does not exist, we must take the scale of the plan. and then give the possibility to add the part revision as well as the registration file.

Hello @tous
Indeed there is no risk in skipping a view, because the first view returned and the sheet active,
Attached is a code which must correspond to the main lines,
Unfolded view scale or sheet if unfolded does not exist
Implementing the revision (default property name "revision"
Possibility to choose the repertoire.
Note that I used the factor parameter which is obsolete, since sw does not offer an option at the moment

As a result, it is necessary to do more in-depth tests than dab (on my side it works for 2018 and 2022)


'----------------------------------------------------------------------------
Option Explicit
    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swdrawing               As DrawingDoc
    Dim spathname               As String
    Dim nErrors                 As Long
    Dim nWarnings               As Long
    Dim bRet                    As Boolean

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swdrawing = swModel
    
    swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputNoScale, 1
    swApp.SetUserPreferenceDoubleValue swDxfOutputScaleFactor, getScaleFactor()
    
    Dim path As String, name As String, revision As String
    name = getPathName(swModel)(0)
    path = getPathName(swModel)(1)
    revision = getRevision()
    
    Dim newPath As String
    Select Case MsgBox("Saving folder is : " + Chr(10) + path + Chr(10) + "press yes to save , no to browse for path or cancel to abort", vbYesNoCancel)
    Case 7
        path = browseFolder(path)
    Case 2
        End
    End Select
    Dim spathname As String
    spathname = path + "\" + name + "_" + revision
    savedrawingasdxf spathname
    savedrawingaspdf spathname

End Sub

Sub savedrawingasdxf(path As String)
    bRet = swModel.Extension.SaveAs(path + ".dxf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings)
    If bRet = False Then
        swApp.SendMsgToUser2 "Problems saving file as dxf.", swMbWarning, swMbOk
    End If
End Sub

Sub savedrawingaspdf(path As String)
    Dim expdata As ExportPdfData
    Set expdata = swApp.GetExportFileData(1)
    bRet = swModel.Extension.SaveAs(path + ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, expdata, nErrors, nWarnings)
    If bRet = False Then
        swApp.SendMsgToUser2 "Problems saving file as pdf.", swMbWarning, swMbOk
    End If
End Sub

Function getScaleFactor() As Double
    Dim sview As View
    Dim scalfactor As Double
    Set sview = swdrawing.GetFirstView
    scalfactor = sview.ScaleRatio(1) / sview.ScaleRatio(0)
    Set sview = sview.GetNextView
    Do While Not sview Is Nothing
        If sview.IsFlatPatternView Then
            scalfactor = sview.ScaleRatio(1) / sview.ScaleRatio(0)
            Exit Do
        End If
        Set sview = sview.GetNextView
    Loop
    getScaleFactor = scalfactor
End Function

Function getPathName(model As ModelDoc2) As Variant
    Dim pathname(1) As String
    Dim spathname As String
    spathname = model.getPathName
    If spathname = "" Then
        swApp.SendMsgToUser2 "Please save file then retry.", swMbStop, swMbOk
        End
    End If
    spathname = Left(spathname, Len(spathname) - 7)
    pathname(0) = Right(spathname, Len(spathname) - InStrRev(spathname, "\", -1, vbTextCompare))
    pathname(1) = Left(spathname, InStrRev(spathname, "\", -1, vbTextCompare) - 1)
    getPathName = pathname
End Function

Function getRevision(Optional prp As String = "revision") As String
    Dim ssheet As Sheet
    Set ssheet = swdrawing.GetCurrentSheet()
    Dim prpsheet As String
    prpsheet = ssheet.CustomPropertyView
    Dim sview As View
    Set sview = swdrawing.GetFirstView
    If prpsheet = "Par défaut" Then
        Set sview = sview.GetNextView
    Else
        Set sview = sview.GetNextView
        Do While Not sview Is Nothing
            If sview.GetName2() = prpsheet Then
                Exit Do
            End If
            Set sview = sview.GetNextView
        Loop
    End If
    Dim srefmodel As ModelDoc2
    Set srefmodel = sview.ReferencedDocument
    Dim scustomprpmgr As CustomPropertyManager
    Set scustomprpmgr = srefmodel.Extension.CustomPropertyManager(sview.ReferencedConfiguration)
    Dim svOut As String
    Dim sWRout As Boolean
    Dim sLPout As Boolean
    Dim srevision As String
    scustomprpmgr.Get6 prp, False, svOut, srevision, sWRout, sLPout
    getRevision = srevision
End Function

Function browseFolder(defpath As String) As String
    browseFolder = defpath
    Dim obgShell As Object
    Dim obgFolder As Object
    Set obgShell = CreateObject("shell.application")
    Set obgFolder = obgShell.browseforfolder(0, "", 0)
    If Not obgFolder Is Nothing Then
        browseFolder = obgFolder.self.path
    End If
    Set obgShell = Nothing
End Function



1 Like

Hello @Lynkoa15 ,
Sorry for the late reply, the holidays have been there...
Thank you for your feedback and this code.
On the other hand unfortunately it doesn't work for me, I have an error on the following line:
scustomprpmgr. Get6 prp, False, svOut, srevision, sWRout, sLPout
I don't know the source of the error...
On the other hand, a clarification, my custom property for the revision is called "Index", maybe it comes from there? If so, where do I need to modify in the code?

Does this macro work to create pdf and dxf then? And does it create the pdf/dxf of the different folios separately.
Thank you again in advance for your help

Hello
For the problem related to the name of the property you have to change here

Change revision by index

1 Like

@Cyril.f doesn't work much better.
I get the same error message on the same line

Hello ediata and good luck for the return to work

Regarding the export pdf and dxf, it's yes.
Concerning the multifolio, the macro exports the active sheet only but populate on different sheets and feasible,
For the moment we will have to find out what is wrong.
For the possible "revision" property of the declared as indicated by cyril, by changing the default name, otherwise indie the name here

Regarding the error, I would say that you have a version lower than 2018, is this the case? (a screenshot of this error message will be welcome)

1 Like

Yes, I am indeed on SW2017.
Below are the screenshots:
image

At first glance, the Get6 is compatible from SW2018.
Use this line to replace the line in error, if I'm not wrong it should be better unless other functions are in the same case (incompatible with SW2017)

scustomprpmgr.Get5 prp, False, svOut, srevision, sWRout
2 Likes

Thank you @sbadenis , it worked great.
Last question @Lynkoa15, would it be possible to make it possible to save the pdf and the dxf in different folders?

Would there be a line or a simple code to add to be able to export as a step?

Below is a code that should be suitable,
The dwg, pdf and step subfolders in relation to the work folder are declared here, with prp revision
Capture08

The prp revision and configuration for the step came from there
Capture07
So the sheet can handle several different components (otherwise I invite you to open a new station for the step)

On my side for the sheet metal cuts I always add a dimension, so my nesting colleague can check and report to me any scaling error (never know)

'----------------------------------------------------------------------------
Option Explicit
    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swdrawing               As DrawingDoc
    Dim spathname               As String
    Dim nErrors                 As Long
    Dim nWarnings               As Long
    Dim bRet                    As Boolean
    Const dxfSubFolder As String = "\dwg"
    Const pdfSubFolder As String = "\pdf"
    Const stepSubFolder As String = "\step"
    Const prpRevision As String = "indice"
    
Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swdrawing = swModel
    
    swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputNoScale, 1
    swApp.SetUserPreferenceDoubleValue swDxfOutputScaleFactor, getScaleFactor()
    
    Dim path As String, name As String, configuration As String, revision As String
    Dim model As ModelDoc2
    getParameters model, configuration, revision, prpRevision
    name = getPathName(swModel)(0)
    name = name + "_" + revision
    path = getPathName(swModel)(1)

    Dim newPath As String
    Select Case MsgBox("Saving folder is : " + name + Chr(10) + "Export configuration for STEP is : " + configuration + Chr(10) + "working folder is : " + path + Chr(10) + Chr(10) + "press yes to save , no to browse for path or cancel to abort", vbYesNoCancel)
    Case 7
        path = browseFolder(path)
    Case 2
        End
    End Select
    
    createpath path + dxfSubFolder
    savedrawingasdxf path + dxfSubFolder + "\" + name
    
    createpath path + pdfSubFolder
    savedrawingaspdf path + pdfSubFolder + "\" + name
    
    createpath path + stepSubFolder
    savedrawingasstep model, configuration, path + stepSubFolder + "\" + name

    swApp.SendMsgToUser2 "Finish", swMbInformation, swMbOk
End Sub

Sub createpath(path As String)
    Dim fold As Variant
    Dim cpath As String
    For Each fold In Split(path, "\", -1, vbTextCompare)
        cpath = cpath + CStr(fold) + "\"
        If Len(Dir(cpath, vbDirectory)) = 0 Then MkDir cpath
    Next fold
End Sub


Sub savedrawingasdxf(path As String)
    bRet = swModel.Extension.SaveAs(path + ".dwg", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings)
    If bRet = False Then
        swApp.SendMsgToUser2 "Problems saving file as dxf.", swMbWarning, swMbOk
    End If
End Sub

Sub savedrawingaspdf(path As String)
    Dim expdata As ExportPdfData
    Set expdata = swApp.GetExportFileData(1)
    expdata.SetSheets 2, Nothing
    bRet = swModel.Extension.SaveAs(path + ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, expdata, nErrors, nWarnings)
    If bRet = False Then
        swApp.SendMsgToUser2 "Problems saving file as pdf.", swMbWarning, swMbOk
    End If
End Sub

Sub savedrawingasstep(model As ModelDoc2, conf As String, path As String)
    If model Is Nothing Then Exit Sub
    Set model = swApp.ActivateDoc3(model.getPathName, False, 1, nErrors)
    model.ShowConfiguration2 conf
    bRet = model.Extension.SaveAs(path + ".step", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings)
    If bRet = False Then
        swApp.SendMsgToUser2 "Problems saving file as step.", swMbWarning, swMbOk
    End If
    swApp.CloseDoc model.GetTitle
End Sub

Function getScaleFactor() As Double
    Dim sview As View
    Dim scalfactor As Double
    Set sview = swdrawing.GetFirstView
    scalfactor = sview.ScaleRatio(1) / sview.ScaleRatio(0)
    Set sview = sview.GetNextView
    Do While Not sview Is Nothing
        If sview.IsFlatPatternView Then
            scalfactor = sview.ScaleRatio(1) / sview.ScaleRatio(0)
            Exit Do
        End If
        Set sview = sview.GetNextView
    Loop
    getScaleFactor = scalfactor
End Function

Function getPathName(model As ModelDoc2) As Variant
    Dim pathname(1) As String
    Dim spathname As String
    spathname = model.getPathName
    If spathname = "" Then
        swApp.SendMsgToUser2 "Please save file then retry.", swMbStop, swMbOk
        End
    End If
    spathname = Left(spathname, Len(spathname) - 7)
    pathname(0) = Right(spathname, Len(spathname) - InStrRev(spathname, "\", -1, vbTextCompare))
    pathname(1) = Left(spathname, InStrRev(spathname, "\", -1, vbTextCompare) - 1)
    getPathName = pathname
End Function

Sub getParameters(ByRef model As ModelDoc2, ByRef configuration As String, ByRef revision As String, Optional prp As String = "revision")
    Dim ssheet As Sheet, csheet As Sheet
    Set csheet = swdrawing.GetCurrentSheet()
    Set ssheet = csheet
    Dim prpDoc As Boolean
    prpDoc = ssheet.GetProperties2()(7)
    If prpDoc = True Then
            swdrawing.ActivateSheet swdrawing.GetSheetNames()(0)
            Set ssheet = swdrawing.GetCurrentSheet()
    End If
    Dim prpsheet As String
    prpsheet = ssheet.CustomPropertyView
    Dim sview As View
    If prpsheet = "Par défaut" Then
        Set sview = swdrawing.GetFirstView
        Set sview = sview.GetNextView
    Else
        Dim views As Variant
        Dim found As Boolean
        found = False
        views = swdrawing.GetViews()
        Dim i As Long
        For i = 0 To UBound(views)
            If UBound(views(i)) = 0 Or found = True Then Exit For
            Dim j As Long
            For j = 1 To UBound(views(i))
                Set sview = views(i)(j)
                If sview.GetName2() = prpsheet Then
                    found = True
                    Exit For
                End If
            Next j
        Next i
    End If
    swdrawing.ActivateSheet csheet.GetName
    If sview Is Nothing Then Exit Sub
    Set model = sview.ReferencedDocument
    Dim scustomprpmgr As CustomPropertyManager
    configuration = sview.ReferencedConfiguration
    If sview.IsFlatPatternView Then
        Dim confvf As configuration
        Set confvf = model.GetConfigurationByName(configuration)
        Set confvf = confvf.GetParent()
        configuration = confvf.name
    End If
    Set scustomprpmgr = model.Extension.CustomPropertyManager(configuration)
    Dim svOut As String
    Dim sWRout As Boolean
    Dim sLPout As Boolean
    Dim srevision As String
    'scustomprpmgr.Get6 prp, False, svOut, srevision, sWRout, sLPout
    scustomprpmgr.Get5 prp, False, svOut, srevision, sWRout
    revision = srevision
End Sub

Function browseFolder(defpath As String) As String
    browseFolder = defpath
    Dim obgShell As Object
    Dim obgFolder As Object
    Set obgShell = CreateObject("shell.application")
    Set obgFolder = obgShell.browseforfolder(0, "", 0)
    If Not obgFolder Is Nothing Then
        browseFolder = obgFolder.self.path
    End If
    Set obgShell = Nothing
End Function

1 Like

Thank you @Lynkoa15 .
The macro works well to create the different folders. It's great!
On the other hand, the index (revision) of the part is not added to the name of the files (pdf/dxf/step). Could it be because the macro can't find it? Normally the clue is in the custom properties of the part being drawn (the 3D).