CAD Forum

Code: Select all

Dim swApp As SldWorks.SldWorks


Sub main()

Dim FileNamesArr()
ReDim FileNamesArr(6)
FileNamesArr(0) = "Y:\macro\DXFtoJPG\File01.DXF"
FileNamesArr(1) = "Y:\macro\DXFtoJPG\File02.DXF"
FileNamesArr(2) = "Y:\macro\DXFtoJPG\File03.DXF"
FileNamesArr(3) = "Y:\macro\DXFtoJPG\File04.DXF"
FileNamesArr(4) = "Y:\macro\DXFtoJPG\File05.DXF"
FileNamesArr(5) = "Y:\macro\DXFtoJPG\File06.DXF"
FileNamesArr(6) = "Y:\macro\DXFtoJPG\File07.DXF"

'You can use the Excel library to select a group of files (DXF) from a folder if you do not have an array with names from the previous macro work.

SaveJPGfromDXF (FileNamesArr)
End Sub



'============Creating a drawing file for importing a group of DXFs and exporting them to JPG
Function SaveJPGfromDXF(FilePatches As Variant, Optional swApp As Object)
'Settings
Const Export_File_Format = ".jpg"
Const DRW_Paper_SIZE_X = 100  'mm
Const DRW_Paper_SIZE_Y = 100  'mm
Const Export_File_SIZE_X = 400 'px
Const Export_File_SIZE_Y = 400 'px
Const Export_File_DPI = 100 '100 DPI I have not tried whether it is possible to change outside the range of the list presented in the SW settings


If swApp Is Nothing Then Set swApp = Application.SldWorks

Dim PrintDrawingPaperWidth, PrintDrawingPaperHeight As Double

PrintDrawingPaperWidth = (Export_File_SIZE_X / DRW_Paper_SIZE_X * 25.4) / 1000
PrintDrawingPaperHeight = (Export_File_SIZE_Y / DRW_Paper_SIZE_Y * 25.4) / 1000

Dim boolstatus As Boolean
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swTiffImageType, swTiffImageType_e.swTiffImageGrayScale) 'swTiffImageRGB - Color  swTiffImageBlackAndWhite - BlackAndWhite
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swTiffCompressionScheme, swTiffCompressionScheme_e.swTiffPackbitsCompression) 'swTiffGroup4FaxCompression - Color
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swTiffPrintDPI, Export_File_DPI) '100 DPI I have not tried whether it is possible to change outside the range of the list presented in the SW settings
boolstatus = swApp.SetUserPreferenceDoubleValue(swUserPreferenceDoubleValue_e.swTiffPrintDrawingPaperWidth, PrintDrawingPaperWidth) '101.6 mm
boolstatus = swApp.SetUserPreferenceDoubleValue(swUserPreferenceDoubleValue_e.swTiffPrintDrawingPaperHeight, PrintDrawingPaperHeight) ' x 101.6 mm
             swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swTiffPrintScaleToFit, False
    
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swFeatMgr As SldWorks.FeatureManager
    Dim swFeat As SldWorks.Feature
    Dim swSketch As SldWorks.Sketch
    Dim swSketchManager As Object
    Dim swSheet As SldWorks.Sheet
    Dim swView As SldWorks.View
    Dim bRet As Boolean
    Dim importData As SldWorks.ImportDxfDwgData
   
    Set swModel = swApp.NewDocument(swApp.GetUserPreferenceStringValue(swDefaultTemplateDrawing), swDwgPapersUserDefined, (DRW_Paper_SIZE_X / 1000), (DRW_Paper_SIZE_Y / 1000))
    Set swDraw = swModel
    Set swSheet = swDraw.GetCurrentSheet
    swSheet.SetName "DXF"
    
    Dim filename
    
    For Each filename In FilePatches
    
            Dim filenameExport As String
        
            bRet = swModel.Extension.SelectByID2("DXF", "SHEET", 0#, 0#, 0, False, 0, Nothing, 0)
            Set swFeatMgr = swModel.FeatureManager
            Set importData = swApp.GetImportFileData(filename)
            
            ' Import method
            importData.ImportMethod("") = swImportDxfDwg_ImportMethod_e.swImportDxfDwg_ImportToExistingDrawing
             'importData.ImportMethod("") = swImportDxfDwg_ImportMethod_e.swImportDxfDwg_ImportToDrawing
             'importData.ImportMethod("") = swImportDxfDwg_ImportMethod_e.swImportDxfDwg_DoNotImportSheet
            
            ' Unit
            'importData.LengthUnit("") = SwConst.swLengthUnit_e.swINCHES
                   
            ' Position
            bRet = importData.SetPosition("", swDwgEntitiesCentered, 0, 0)
                
            ' Sheet scale
            bRet = importData.SetSheetScale("", 1#, 1#)
        
            ' Paper size
            bRet = importData.SetPaperSize("", SwConst.swDwgPaperSizes_e.swDwgPapersUserDefined, (DRW_Paper_SIZE_X / 1000), (DRW_Paper_SIZE_Y / 1000))

            ' Import DXF file with importData
            Set swFeat = swFeatMgr.InsertDwgOrDxfFile2(filename, importData)

            Dim BoxFeatureArray             As Variant
            Dim status                      As Boolean
            'Gets the bounding box for "this" feature
            'The resulting box encloses the object, but it might not be the tightest box.
            status = swFeat.GetBox(BoxFeatureArray) 'We find the dimensional box of the sketch that was obtained during import (Array containing the two diagonal points)
            Dim deltaX As Double
            Dim deltaY As Double
            ' Calculate the difference between x and y coordinates
            deltaX = BoxFeatureArray(3) - BoxFeatureArray(0)
            deltaY = BoxFeatureArray(4) - BoxFeatureArray(1)
            ' Calculate the square of the distance
            Dim distanceSquared As Double
            distanceSquared = (deltaX ^ 2) + (deltaY ^ 2)
            ' Calculate distance by taking square root
            Dim CalculateDistance As Double
            CalculateDistance = Sqr(distanceSquared)
            'We set the scale of the sheet so that the imported sketch fits into the size of the drawing paper.
            '(here I am only considering a square drawing, if you need a rectangular one: organize a check on the larger side).
            status = swSheet.SetScale(1, CalculateDistance / (DRW_Paper_SIZE_X / 1000), False, False)
            'The exported file has the same path and name, but a different extension (.jpg)
             filenameExport = Replace(filename, ".DXF", Export_File_Format)
             Dim longstatus As Long
             longstatus = swDraw.SaveAs3(filenameExport, 0, 1) 'same version, silent save
            'Find the view that received our imported sketch
            Set swSketch = swFeat.GetSpecificFeature2
            Set swView = swDraw.GetFirstView
            Do While Not swView Is Nothing
                If swSketch Is swView.GetSketch Then
                    Exit Do
                End If
                Set swView = swView.GetNextView
            Loop
             
          'Select the view with imported DÕF
          bRet = swModel.Extension.SelectByID2(swView.GetName2, "DRAWINGVIEW", 0#, 0#, 0, False, 0, Nothing, 0)
          'Delete the selected view
          swModel.EditDelete

    Next filename 'Let's get the next file from the path array
swApp.CloseDoc "" 'After saving all the files, close the created drawing.
End Function

Code: Select all

Dim swApp As SldWorks.SldWorks

Sub main()

Set swApp = Application.SldWorks

    Dim FileFromSelect As String '
    Dim FilesCompNames() As String
    '  Tools-Reference... Microsoft Excel xx + Microsoft Office xx + Microsoft Forms 2.0 library FM20.dll
    Dim xlApp As Excel.Application
    Set xlApp = New Excel.Application
    xlApp.Visible = False
    xlApp.DisplayAlerts = False
    With xlApp.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "dxf", "*.DXF; *.dxf"
        .FilterIndex = 1
        .InitialView = msoFileDialogViewList
        .Title = "Select dxf files to convert to jpg"
        '.Show
    If .Show = 0 Then
         MsgBox "Nothing selected"
                 End
    Else
        On Error Resume Next
            Err.Clear
            If Err.Number <> 0 Then
                MsgBox "You haven't chosen anything!"
                 'clean up excel from memory
                 xlWB.Close
                 Set xlWB = Nothing
                 xlApp.Quit
                 Set xlApp = Nothing
                 MsgBox "It's not clear, ciao"
                 End
            End If
        ReDim FilesCompNames(.SelectedItems.Count - 1) 'We convert the array with search results into a string array.
            For xx = 1 To .SelectedItems.Count
              FilesCompNames(xx - 1) = CStr(.SelectedItems(xx))
            Next xx
    End If
    End With
 
  'clean up excel from memory
    xlWB.Close
     Set xlWB = Nothing
    xlApp.Quit
     Set xlApp = Nothing

SaveJPGfromDXF (FilesCompNames)

End Sub