It is understood that the file paths could be obtained in different ways. For example, you can organize multiple selection of DXF files from a folder using the Excel library, since SW does not know how to do this (I don’t know about this).
For example, in the main Sub, a static array with paths was simply created to test the operation of the function. Everything else is in the comments in the code.
- File04.jpg (13.79 KiB) Viewed 342 times
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