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")

 

 

'Code

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
swDoc.EditCopy

 

'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
swDXFDoc.ViewZoomtofit2

 

'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
swDXFDoc.Paste

 

 

 

'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")
swDXFDoc.EditDelete

 


    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

 

    Else

 

        swView.ShowSheetMetalBendNotes = False

 

    End If

 

 

 

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

 


    swModel.EditRebuild3

 


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

 

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

 


    
    
    
Else
    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

 

     

 

    Else
     

 

    boolstatus = swDXFDoc.SaveAs(DXFfilename)

 

     

 

    End If

 

 

 

 

 


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

 

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

 

End Sub

Outcomes