AnsweredAssumed Answered

Macro for DXF Working for me and not for my co-workers

Question asked by Kim Eriksson on Jun 24, 2020
Latest reply on Jun 30, 2020 by Kim Eriksson

Hey. I have a macro that exports a selected view from a drawing and removes the annotations and bendlines and saves it as the drawing name with rev status. The problem occured when they both got new computers and did a fresh installing of solidworks 2020. I have checked the Reference so it says 2020.


anyone have an idea?



The error ocurs on the line:

boolstatus = swDXFDoc.Extension.SketchBoxSelect("-100", "-100", "0.000000", "300", "300", "0.000000")




Const BlankTemplatePath As String = "K:\xxxx\xxxx\SolidWorks\Templates\DXF.drwdot"


'Const OutputPath As String = "C:\DXF" 'fixed path
'Const OutputPath As String = "\" 'same folder as solidworks file.
Const OutputPath As String = "\DXF" 'new subfolder in solidowkrs file folder


Dim boolstatus As Boolean
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swDXFDoc As SldWorks.ModelDoc2
Dim swView As SldWorks.View
Dim swDXFView As SldWorks.View
Dim swFeat As SldWorks.Feature
Dim swDraw As SldWorks.DrawingDoc
Dim pathName As String
Dim Revision As String
Dim fso As New Scripting.FileSystemObject






Sub main()


Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc


'Only works on drawings
If swDoc.GetType <> swDocDRAWING Then
    MsgBox "Enbart För Ritningar."
    Exit Sub
End If


'Make sure a view is selected
Set swView = swDoc.ActiveDrawingView
If swView Is Nothing Then
    MsgBox "OBS Välj Vy. "
    Exit Sub
End If


'copy selected view(s) to clipboard


'create a temporary drawing  (edit this path to use your blank template)
Set swDXFDoc = swApp.NewDocument(BlankTemplatePath, 0, 0, 0)

Set Part = swApp.ActiveDoc
boolstatus = Part.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplaySketches, False)




'make sure we are looking at the whole blank sheet


'click in the middle of the sheet to define paste location
boolstatus = swDXFDoc.Extension.SelectByID2("Sheet1", "SHEET", 0.2, 0.15, 0, False, 0, Nothing, 0)


'paste view from clipboard




'Select the first view on the sheet
Set swDXFView = swDXFDoc.GetFirstView  '(this just selects the sheet)
Set swDXFView = swDXFView.GetNextView


boolstatus = swDXFDoc.Extension.SelectByID2(swDXFView.Name, "DRAWINGVIEW", 0.2, 0.15, 0, False, 0, Nothing, 0)




'Select and delete all the dims and notes on temp drawing
Set Note = swDXFDoc.InsertNote("temp") 'make sure there is at least one object to delete, or below will delete the view!
boolstatus = swDXFDoc.Extension.SketchBoxSelect("-100", "-100", "0.000000", "300", "300", "0.000000")


    Set swApp = Application.SldWorks


    Set swModel = swApp.ActiveDoc


    Set swDraw = swModel


    Set swFeat = swDraw.FeatureByName("Drawing View1")


    Set swView = swFeat.GetSpecificFeature2


    If swView.ShowSheetMetalBendNotes = False Then


        swView.ShowSheetMetalBendNotes = True




        swView.ShowSheetMetalBendNotes = False


    End If




'make sure DXF is scaled 1:1 and rebuild
swDXFView.ScaleDecimal = 1




boolstatus = Part.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swShowSheetMetalBendNotes, 1, False)


'Set (and make) folder for dxfs
If (InStr(OutputPath, ":\") Or InStr(OutputPath, "\\")) Then
    DXFFolder = OutputPath


    DocFolder = Left(swDoc.GetPathName, InStrRev(swDoc.GetPathName, "\") - 1)
    DXFFolder = DocFolder & OutputPath


End If
If Dir(DXFFolder, vbDirectory) = vbNullString Then
    MkDir (DXFFolder)
End If


'save DXF (SW knows to save as DXF filetype by the extension)
DXFfilename = DXFFolder & "\" & Left(swDoc.GetTitle(), Len(swDoc.GetTitle()) - Len(swDoc.GetCurrentSheet().GetName) - 3) & " Rev " & swDoc.GetCustomInfoValue("", "Revision") & ".dxf"
'boolstatus = swDXFDoc.SaveAs(DXFfilename)


    If Dir(DXFFolder & "\" & Left(swDoc.GetTitle(), Len(swDoc.GetTitle()) - Len(swDoc.GetCurrentSheet().GetName) - 3) & " Rev " & swDoc.GetCustomInfoValue("", "Revision") & ".dxf") <> "" Then




    Dim result As Integer
    result = vbNo Or CloseDoc
    result = MsgBox(fname & " Vill Du Ersätta DXF Filen?", vbYesNo, "DXF FINNS REDAN!")
      'MsgBox "Det Existerar Redan En DXF Med Det Namnet"
          If Exists Or (result = vbYes) Then
      boolstatus = swDXFDoc.SaveAs(DXFfilename)


    End If






    boolstatus = swDXFDoc.SaveAs(DXFfilename)




    End If






'close temporary drawing
swApp.CloseDoc (swDXFDoc.GetTitle)


'MsgBox ("DXF saved here: \n" & Chr(13) & DXFfilename)


End Sub