Dim swApp As Object Dim swModel As SldWorks.ModelDoc2 Dim swDrawing As SldWorks.DrawingDoc Dim swAssembly As SldWorks.AssemblyDoc Dim swExtension As SldWorks.ModelDocExtension Dim swConfMgr As SldWorks.ConfigurationManager Dim swPDFExport As SldWorks.ExportPdfData Dim swDocSpecification As SldWorks.DocumentSpecification Dim errors As Long Dim warnings As Long dim message as string Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long Private Declare Function PathIsRelative Lib "shlwapi.dll" Alias "PathIsRelativeA" (ByVal pszPath As String) As Long Function PathAppend(path, more) As String If Not Right(path, 1) = "\" Then path = path & "\" End If If Left(more, 1) = "\" Then more = Mid(more, 2) End If PathAppend = path & more End Function Sub Log(message) Dim errorLogFolder As String Dim errorLogPath As String ' Determine error log output path errorLogFolder = "[ErrorLogPath]" ' Trim \ from the start If Left(errorLogFolder, 1) = "\" Then errorLogFolder = Mid(errorLogFolder, 2) End If ' Build full root If PathIsRelative( errorLogFolder ) = 1 Then errorLogPath = PathAppend("", errorLogFolder) Else errorLogPath = errorLogFolder End If ' Create directory if not exists SHCreateDirectoryEx ByVal 0&, errorLogPath, ByVal 0& errorLogPath = PathAppend(errorLogPath, ".log") ' Write error to output file Open errorLogPath For Append As #1 Print #1, message Close #1 End Sub Sub CreatePath(path) ' Create directory if not exists If SHCreateDirectoryEx(ByVal 0&, path, ByVal 0&) = 0 Then ' Create temp file Open path & "~$holder" For Append As #1 Close #1 End If End Sub Sub KillHolder(path) On Error Goto Ignore Kill path & "~$holder" Ignore: End Sub Function GetExtension(docType, fileFormat) first = InStr(1, fileFormat, "(") last = InStr(first, fileFormat, ")") extensions = Mid(fileFormat, first + 1, last - first - 1) If InStr(1, extensions, ";") > 0 Then Dim all As Variant all = Split(extensions, ";") If UBound(all) >= docType - 1 Then ext = all(docType - 1) Else ext = "*." ' Nothing End If Else ext = extensions End If GetExtension = Mid(Trim(ext), 2) End Function Sub SetConversionOptions(ext) ' PDF options If LCase(ext) = ".pdf" Then swApp.SetUserPreferenceToggle swPDFExportInColor, [PdfInColor] swApp.SetUserPreferenceToggle swPDFExportEmbedFonts, [PdfEmbedFonts] swApp.SetUserPreferenceToggle swPDFExportHighQuality, [PdfHighQuality] swApp.SetUserPreferenceToggle swPDFExportPrintHeaderFooter, [PdfPrintHeaderFooter] swApp.SetUserPreferenceToggle swPDFExportUseCurrentPrintLineWeights, [PdfUsePrinterLineWeights] ' IGES ElseIf LCase(ext) = ".igs" Then swApp.SetUserPreferenceToggle swIGESExportSolidAndSurface, [IgesExportSolidSurface] swApp.SetUserPreferenceIntegerValue swIGESRepresentation, [IgesRepresentation] swApp.SetUserPreferenceToggle swIGESExportAsWireframe, [IgesExportWireframe] swApp.SetUserPreferenceIntegerValue swIGESCurveRepresentation, [IgesCurveRepresentation] swApp.SetUserPreferenceIntegerValue swIGESSystem, [IgesSystem] swApp.SetUserPreferenceToggle swIGESExportFreeCurves, [IgesExportFreeCurves] swApp.SetUserPreferenceToggle swIGESExportSketchEntities, [IgesExportSketchEntities] swApp.SetUserPreferenceToggle swIGESHighTrimCurveAccuracy, [IgesHighCurveAccuracy] swApp.SetUserPreferenceToggle swIGESComponentsIntoOneFile, [IgesComponentsIntoOneFile] swApp.SetUserPreferenceToggle swIGESFlattenAssemHierarchy, [IgesFlattenAssemblyHierarchy] ' ACIS ElseIf LCase(ext) = ".sat" Then swApp.SetUserPreferenceIntegerValue swAcisOutputGeometryPreference, [AcisGeometry] swApp.SetUserPreferenceIntegerValue swOutputVersion, [AcisVersion] swApp.SetUserPreferenceIntegerValue swAcisOutputUnits, [AcisOutputAsUnit] ' STEP ElseIf LCase(ext) = ".step" Then swApp.SetUserPreferenceIntegerValue swAcisOutputGeometryPreference, [StepGeometry] swApp.SetUserPreferenceIntegerValue swStepAP, [StepVersion] ' Parasolid ElseIf LCase(ext) = ".x_t" Or LCase(ext) = ".x_b" Then swApp.SetUserPreferenceIntegerValue swParasolidOutputVersion, [ParasolidVersion] swApp.SetUserPreferenceToggle swXTAssemSaveFormat, [ParasolidFlattenHierarchy] ' VRML ElseIf LCase(ext) = ".wrl" Then swApp.SetUserPreferenceIntegerValue swExportVrmlUnits, [VrmlOutputAsUnit] swApp.SetUserPreferenceToggle swExportVrmlAllComponentsInSingleFile, [VrmlSaveAssemblyAsOneFile] ' STL ElseIf LCase(ext) = ".stl" Then swApp.SetUserPreferenceToggle swSTLBinaryFormat, [StlOutputAs] swApp.SetUserPreferenceIntegerValue swExportStlUnits, [StlOutputAsUnit] swApp.SetUserPreferenceIntegerValue swSTLQuality, [StlQuality] swApp.SetUserPreferenceToggle swSTLDontTranslateToPositive, [StlDontTranslatePositive] swApp.SetUserPreferenceToggle swSTLComponentsIntoOneFile, [StlComponentsIntoOneFile] swApp.SetUserPreferenceToggle swSTLCheckForInterference, [StlCheckForInterferences] ' TIF or PSD ElseIf LCase(ext) = ".tif" Or LCase(ext) = ".psd" Then swApp.SetUserPreferenceIntegerValue swTiffImageType, [TifImageType] swApp.SetUserPreferenceIntegerValue swTiffCompressionScheme, [TifCompressionScheme] ' eDrawings ElseIf LCase(ext) = ".eprt" Or LCase(ext) = ".easm" Or LCase(ext) = ".edrw" Then swApp.SetUserPreferenceToggle swEDrawingsOkayToMeasure, [EdrwOkayToMeasure] swApp.SetUserPreferenceToggle swEDrawingsExportSTLOkay, [EdrwAllowExportOfSTL] swApp.SetUserPreferenceToggle swEDrawingsSaveShadedDataInDrawings, [EdrwSaveShadedData] swApp.SetUserPreferenceToggle swEDrawingsSaveBOM, [EdrwSaveBOM] swApp.SetUserPreferenceToggle swEDrawingsSaveAnimationOkay, [EdrwSaveMotionStudies] swApp.SetUserPreferenceToggle swEDrawingsSaveAnimationToAllConfigs, [EdrwSaveMotionStudiesToAllConfs] swApp.SetUserPreferenceToggle swEDrawingsSaveAnimationRecalculate, [EdrwRecalcMotionStudies] End If End Sub Function GetFullFileName(convFileName, conf, i, itemCount) ' Configuration name may include backslash. Remove it since otherwise saving will ' fail due a missing directory conf = Replace(conf, "\", "") conf = Replace(conf, "/", "") finalFileName = Replace(convFileName, "", conf) ' If no configuration If finalFileName = convFileName And itemCount > 0 Then finalFileName = Left(convFileName, InStrRev(convFileName, ".") - 1) & "_" & i & Mid(convFileName, InStrRev(convFileName, ".")) End If ' Remove illegal characters from filename finalFileName = Replace(finalFileName, "<", "") finalFileName = Replace(finalFileName, ">", "") finalFileName = Left(finalFileName, 2) + Replace(finalFileName, ":", "", 3) ' Don't start from begin since drive has : finalFileName = Replace(finalFileName, "*", "") finalFileName = Replace(finalFileName, "?", "") finalFileName = Replace(finalFileName, """", "") finalFileName = Replace(finalFileName, "|", "") GetFullFileName = finalFileName End Function Sub Convert(docFileName) ' Constants for some SolidWorks error/warning returns that may be encountered during a convert operation. Const swerr_InvalidFileExtension = 256 ' the file extension differs from the SW document type. Const swerr_SaveAsNotSupported = 4096 ' the options selected for this convert aren't supported, output may be incomplete. Const swwarn_MissingOLEObjects = 512 ' the document contains OLE objects and must be opened and converted in SolidWorks. ' Determine type of SolidWorks file based on file extension If LCase(Right(docFileName, 7)) = ".sldprt" Or LCase(Right(docFileName, 4)) = ".prt" Then docType = swDocPART ElseIf LCase(Right(docFileName, 7)) = ".sldasm" Or LCase(Right(docFileName, 4)) = ".asm" Then docType = swDocASSEMBLY ElseIf LCase(Right(docFileName, 7)) = ".slddrw" Or LCase(Right(docFileName, 4)) = ".drw" Then docType = swDocDRAWING Else docType = swDocNONE If bIsSupportedExtension(Mid(docFileName, InStrRev(docFileName, ".") + 1)) = False Then Log "The file extension '" & Mid(docFileName, InStrRev(docFileName, ".") + 1) & "' is not supported." Exit Sub End If End If ' Open document If docType = swDocNONE Then Set swModel = swApp.LoadFile4(docFileName, "", Nothing, errors) docType = swModel.GetType Else Set swDocSpecification = swApp.GetOpenDocSpec(docFileName) swDocSpecification.DocumentType = docType swDocSpecification.ReadOnly = True swDocSpecification.Silent = True swDocSpecification.ConfigurationName = "" swDocSpecification.DisplayState = "" Set swModel = swApp.OpenDoc7(swDocSpecification) errors = swDocSpecification.Error ' Set swModel = swApp.OpenDoc6(docFileName, docType, swOpenDocOptions_Silent Or swOpenDocOptions_ReadOnly, "", errors, warnings) End If If errors = swFutureVersion Then Log "Document '" & docFileName & "' is future version." Exit Sub End If ' Load failed? If swModel Is Nothing Then Log "Method call ModelDoc2::OpenDoc7 for document '" & docFileName & "' failed. Error code " & errors & " returned." Exit Sub End If If Val(Left(swApp.RevisionNumber, 2)) >= 18 Then swApp.Frame.KeepInVisible = True End If swApp.ActivateDoc2 docFileName, True, errors modelPath = swModel.GetPathName() If modelPath = "" Then modelPath = docFileName End If modelFileName = Mid(modelPath, InStrRev(modelPath, "\") + 1) modelFileName = Left(modelFileName, InStrRev(modelFileName, ".") - 1) modelExtension = Mid(modelPath, InStrRev(modelPath, ".") + 1) ' Build destination filenames convFileName = "[OutputPath]" Dim convFileName2 As String convFileName2 = "[OutputPath2]" Dim convFilePath2 As String Dim convFileNameTemp2 As String Dim bSecondOutput As Boolean bSecondOutput = False If (Len(convFileName2) > 0) Then bSecondOutput = True End If ext = GetExtension(docType, "[FileFormat]") convFileName = Replace(convFileName, "", modelFileName) convFileName = Replace(convFileName, "", modelExtension) '--------------------------------------------------------- ' Definition du répertoire de sortie '--------------------------------------------------------- 'msgbox convFileName 'msgbox convFileName2 Dim sPathConvert As String dim position as integer position = InStrRev(convFileName, "\") sPathConvert = left(convFileName, position - 1 ) position = InStrRev(sPathConvert , "\") sPathConvert = Right(sPathConvert , Len(sPathConvert ) - position ) ' 'msgbox sPathConvert Dim sFileConvert As String sFileConvert = Mid(convFileName , InStrRev(convFileName , "\") + 1) sFileConvert = Right(sFileConvert , Len(sFileConvert) - 1 ) ' 'msgbox "sFileConvert=" + sFileConvert ' 'sPathConvert = "T:\PIECES_DUBUS\" + sPathConvert + "\" if left(sFileConvert, 1) = "P" or left(sFileConvert, 2) = "EP" then sPathConvert = "T:\PIECES_DUBUS\" + sPathConvert + "\" end if if left(sFileConvert, 1) = "R" or left(sFileConvert, 2) = "ER" then sPathConvert = "T:\ASSEMBLAGES_DE_REFERENCE\" + sPathConvert + "\" end if convFileName = sPathConvert & sFileConvert ' 'msgbox "convFileName=" + convFileName '--------------------------------------------------- ' fin définition répertoire de sortie '-------------------------------------------------- convFilePath = Left(convFileName, InStrRev(convFileName, "\")) CreatePath convFilePath convFileName = convFileName & ext If bSecondOutput = True Then convFileName2 = Replace(convFileName2, "", modelFileName) convFileName2 = Replace(convFileName2, "", modelExtension) convFilePath2 = Left(convFileName2, InStrRev(convFileName2, "\")) CreatePath convFilePath2 convFileName2 = convFileName2 & ext End If ' Set conversion options SetConversionOptions ext Set swExtension = swModel.Extension If docType = swDocDRAWING Then Dim vSheetNames As Variant Set swDrawing = swModel ' All sheets? If ([OutputSheets] And 2) = 2 Then vSheetNames = swDrawing.GetSheetNames ' Last active sheet? ElseIf ([OutputSheets] And 4) = 4 Then ReDim vSheetNames(0 to 0) As Variant vSheetNames(0) = swDrawing.GetCurrentSheet.GetName() ' Named sheet ElseIf ([OutputSheets] And 8) = 8 Then Dim vSheetNamesTemp As Variant vSheetNamesTemp = swDrawing.GetSheetNames removed = 0 For i = 0 To UBound(vSheetNamesTemp) vSheetNamesTemp(i-removed) = vSheetNamesTemp(i) sheetName = vSheetNamesTemp(i) If Not sheetName Like "[NamedSheet]" Then removed = removed + 1 EndIf Next i If (UBound(vSheetNamesTemp) - removed) >= 0 Then ReDim Preserve vSheetNamesTemp(0 To (UBound(vSheetNamesTemp) - removed)) vSheetNames = vSheetNamesTemp End If End If If Not IsEmpty(vSheetNames) Then ' Save sheets one per file If ([FileSheets] And 4) = 4 Then For i = 0 To UBound(vSheetNames) Dim varSheetName As Variant swDrawing.ActivateSheet vSheetNames(i) convFileNameTemp = GetFullFileName(convFileName, vSheetNames(i), i, UBound(vSheetNames)) If LCase(ext) = ".pdf" Then Set swPDFExport = swApp.GetExportFileData(1) varSheetName = vSheetNames(i) swPDFExport.SetSheets swExportData_ExportSpecifiedSheets, varSheetName ElseIf LCase(ext) = ".edrw" Then swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveActive End If ' Convert the document Success = swExtension.SaveAs(convFileNameTemp, swSaveAsCurrentVersion, swSaveAsOptions_Silent, swPDFExport, errors, warnings) ' Save failed? If Success = False Then If errors = swerr_InvalidFileExtension Then 'msgbox "1" Log "The file '" & docFileName & "' and sheet '" & vSheetNames(i) & "' can't be converted to the file extension '" & ext & "'." Else 'msgbox "2" Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp & "' and sheet '" & vSheetNames(i) & "' failed. Error code " & errors & " returned." If (((errors And swerr_SaveAsNotSupported) <> 0) And ((warnings And swwarn_MissingOLEObjects) <> 0)) Then 'msgbox "3" Log "This document contains OLE objects. Such objects can't be converted outside of SolidWorks. Please open the document and perform the conversion from SolidWorks." End If End if End If If bSecondOutput = True Then convFileNameTemp2 = GetFullFileName(convFileName2, vSheetNames(i), i, UBound(vSheetNames)) Success = swExtension.SaveAs(convFileNameTemp2, swSaveAsCurrentVersion, swSaveAsOptions_Silent, swPDFExport, errors, warnings) ' Save failed? If Success = False Then If errors = swerr_InvalidFileExtension Then Log "The file '" & docFileName & "' and sheet '" & vSheetNames(i) & "' can't be converted to the file extension '" & ext & "'." Else Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp2 & "' and sheet '" & vSheetNames(i) & "' failed. Error code " & errors & " returned." If (((errors And swerr_SaveAsNotSupported) <> 0) And ((warnings And swwarn_MissingOLEObjects) <> 0)) Then Log "This document contains OLE objects. Such objects can't be converted outside of SolidWorks. Please open the document and perform the conversion from SolidWorks." End If End if End If End If Next i ' Save PDF sheets to one file ElseIf ([FileSheets] And 2) = 2 Then If LCase(ext) = ".pdf" Then Set swPDFExport = swApp.GetExportFileData(swExportPdfData) swPDFExport.SetSheets swExportData_ExportSpecifiedSheets, vSheetNames ElseIf LCase(ext) = ".edrw" Then If ([OutputSheets] And 2) = 2 Then ' All sheets? swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveAll ElseIf ([OutputSheets] And 4) = 4 Then ' Last active sheet? swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveActive ElseIf ([OutputSheets] And 8) = 8 Then ' Named sheet swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveSelected selectedSheets = Join(vSheetNames, vbLf) swApp.SetUserPreferenceStringListValue swEmodelSelectionList, Trim(selectedSheets) End If End If convFileNameTemp = GetFullFileName(convFileName, "All", 0, 0) ' Convert the document Success = swExtension.SaveAs(convFileNameTemp, swSaveAsCurrentVersion, swSaveAsOptions_Silent, swPDFExport, errors, warnings) ' Save failed? If Success = False Then '-------------------------------------------------------------------------------- '---- traitement erreur création PDF DUBUS ---------- '-------------------------------------------------------------------------------- if errors <> 4096 and warnings <> 512 then 'msgbox "ERROR " Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp & "' failed. Error code " & errors & " returned." else 'msgbox "WARNING" end if '------------------------------------------------------------------------ '-----------------fin traitement -------------------------------- '----------------------------------------------------------------------- End If If bSecondOutput = True Then convFileNameTemp2 = GetFullFileName(convFileName2, "All", 0, 0) Success = swExtension.SaveAs(convFileNameTemp2, swSaveAsCurrentVersion, swSaveAsOptions_Silent, swPDFExport, errors, warnings) ' Save failed? If Success = False Then Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp2 & "' failed. Error code " & errors & " returned." End If End If End If Else 'msgbox "5" Log "Document '" & docFileName & "' didn't contain any sheets named '[NamedSheet]'." End If Else Dim vConfNames As Variant Set swConfMgr = swModel.ConfigurationManager ' All configurations? If ([OutputConfs] And 2) = 2 Then vConfNames = swModel.GetConfigurationNames ' Last active conf? ElseIf ([OutputConfs] And 4) = 4 Then ReDim vConfNames(0 to 0) As Variant vConfNames(0) = swConfMgr.ActiveConfiguration.Name ' Named confs ElseIf ([OutputConfs] And 8) = 8 Then Dim vConfNamesTemp As Variant vConfNamesTemp = swModel.GetConfigurationNames removed = 0 For i = 0 To UBound(vConfNamesTemp) vConfNamesTemp(i-removed) = vConfNamesTemp(i) confName = vConfNamesTemp(i) If Not confName Like "[NamedConf]" Then removed = removed + 1 EndIf Next i If (UBound(vConfNamesTemp) - removed) >= 0 Then ReDim Preserve vConfNamesTemp(0 To (UBound(vConfNamesTemp) - removed)) vConfNames = vConfNamesTemp End If End If If Not IsEmpty(vConfNames) Then If ([FileConfs] And 4) = 4 Then ' Save configurations For i = 0 To UBound(vConfNames) swModel.ShowConfiguration vConfNames(i) convFileNameTemp = GetFullFileName(convFileName, vConfNames(i), i, UBound(vConfNames)) ' Convert the document Success = swExtension.SaveAs(convFileNameTemp, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, errors, warnings) ' Save failed? If Success = False Then If errors = swerr_InvalidFileExtension Then Log "The file '" & docFileName & "' and configuration '" & vConfNames(i) & "' can't be converted to the file extension '" & ext & "'." Else Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp & "' and configuration '" & vConfNames(i) & "' failed. Error code " & errors & " returned." If (((errors And swerr_SaveAsNotSupported) <> 0) And ((warnings And swwarn_MissingOLEObjects) <> 0)) Then 'msgbox "6" Log "This document contains OLE objects. Such objects can't be converted outside of SolidWorks. Please open the document and perform the conversion from SolidWorks." End If End If End If If bSecondOutput = True Then convFileNameTemp2 = GetFullFileName(convFileName2, vConfNames(i), i, UBound(vConfNames)) Success = swExtension.SaveAs(convFileNameTemp2, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, errors, warnings) ' Save failed? If Success = False Then If errors = swerr_InvalidFileExtension Then Log "The file '" & docFileName & "' and configuration '" & vConfNames(i) & "' can't be converted to the file extension '" & ext & "'." Else 'msgbox "7" Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp2 & "' and configuration '" & vConfNames(i) & "' failed. Error code " & errors & " returned." Log "warnings1 = " & warnings If (((errors And swerr_SaveAsNotSupported) <> 0) And ((warnings And swwarn_MissingOLEObjects) <> 0)) Then Log "This document contains OLE objects. Such objects can't be converted outside of SolidWorks. Please open the document and perform the conversion from SolidWorks." End If End If End If End If Next i ElseIf ([FileConfs] And 2) = 2 Then If LCase(ext) = ".eprt" Or LCase(ext) = ".easm" Then If ([OutputConfs] And 2) = 2 Then ' All confs? swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveAll ElseIf ([OutputConfs] And 4) = 4 Then ' Last active conf? swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveActive ElseIf ([OutputConfs] And 8) = 8 Then ' Named confs swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveSelected selectedConfs = Join(vConfNames, vbLf) swApp.SetUserPreferenceStringListValue swEmodelSelectionList, Trim(selectedConfs) End If End If convFileNameTemp = GetFullFileName(convFileName, "All", 0, 0) ' Convert the document Success = swExtension.SaveAs(convFileNameTemp, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, errors, warnings) ' Save failed? If Success = False Then 'msgbox "8" Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp & "' failed. Error code " & errors & " returned." End If If bSecondOutput = True Then convFileNameTemp2 = GetFullFileName(convFileName2, "All", 0, 0) Success = swExtension.SaveAs(convFileNameTemp2, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, errors, warnings) ' Save failed? If Success = False Then 'msgbox "9" Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp2 & "' failed. Error code " & errors & " returned." End If End If End If Else Log "Document '" & docFileName & "' didn't contain any configurations named '[NamedConf]'." End If End If KillHolder convFilePath KillHolder convFilePath2 ' Process virtual components If docType = swDocASSEMBLY Then Dim vComponents As Variant Set swAssembly = swModel vComponents = swAssembly.GetComponents(True) If Not IsEmpty(vComponents) Then For i = 0 To UBound(vComponents) Dim swComponent As SldWorks.Component2 Set swComponent = vComponents(i) If swComponent.IsVirtual Then Convert swComponent.GetPathName() End If Next i End If End If ' Close document swApp.QuitDoc swModel.GetTitle End Sub Function bIsSupportedExtension(oExtension) As Boolean oExtension = LCase( oExtension ) If oExtension = "prt" Then bIsSupportedExtension = True ElseIf oExtension = "asm" Then bIsSupportedExtension = True ElseIf oExtension = "drw" Then bIsSupportedExtension = True ElseIf oExtension = "dxf" Then bIsSupportedExtension = True ElseIf oExtension = "dwg" Then bIsSupportedExtension = True ElseIf oExtension = "psd" Then bIsSupportedExtension = True ElseIf oExtension = "ai" Then bIsSupportedExtension = True ElseIf oExtension = "lfp" Then bIsSupportedExtension = True ElseIf oExtension = "sldlfp" Then bIsSupportedExtension = True ElseIf oExtension = "prtdot" Then bIsSupportedExtension = True ElseIf oExtension = "asmdot" Then bIsSupportedExtension = True ElseIf oExtension = "drwdot" Then bIsSupportedExtension = True ElseIf oExtension = "x_t" Then bIsSupportedExtension = True ElseIf oExtension = "x_b" Then bIsSupportedExtension = True ElseIf oExtension = "xmt_txt" Then bIsSupportedExtension = True ElseIf oExtension = "xmt_bin" Then bIsSupportedExtension = True ElseIf oExtension = "igs" Then bIsSupportedExtension = True ElseIf oExtension = "iges" Then bIsSupportedExtension = True ElseIf oExtension = "step" Then bIsSupportedExtension = True ElseIf oExtension = "stp" Then bIsSupportedExtension = True ElseIf oExtension = "sat" Then bIsSupportedExtension = True ElseIf oExtension = "vda" Then bIsSupportedExtension = True ElseIf oExtension = "wrl" Then bIsSupportedExtension = True ElseIf oExtension = "stl" Then bIsSupportedExtension = True ElseIf oExtension = "cgr" Then bIsSupportedExtension = True ElseIf oExtension = "wrl" Then bIsSupportedExtension = True ElseIf oExtension = "xpr" Then bIsSupportedExtension = True ElseIf oExtension = "xas" Then bIsSupportedExtension = True ElseIf oExtension = "ipt" Then bIsSupportedExtension = True ElseIf oExtension = "iam" Then bIsSupportedExtension = True ElseIf oExtension = "par" Then bIsSupportedExtension = True ElseIf oExtension = "psm" Then bIsSupportedExtension = True ElseIf oExtension = "ckd" Then bIsSupportedExtension = True ElseIf oExtension = "emn" Then bIsSupportedExtension = True ElseIf oExtension = "brd" Then bIsSupportedExtension = True ElseIf oExtension = "bdf" Then bIsSupportedExtension = True ElseIf oExtension = "idb" Then bIsSupportedExtension = True ElseIf oExtension = "3dm" Then bIsSupportedExtension = True Else bIsSupportedExtension = False End If End Function Sub main() On Error GoTo Fail: docFileName = "" ' Get SW interface object Set swApp = Application.SldWorks Convert docFileName Exit Sub Fail: Log "Error while converting file '" & docFileName & "': " & vbCrLf & _ "An unexpected error occurred while executing the generated script. Script syntax error?" & vbCrLf & _ "Error number: " & Err.Number & vbCrLf & _ "Error description: '" & Err.Description & "'" & vbCrLf End Sub