CAD Forum

Code: Select all

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.PartDoc
Dim sModelName As String
Dim sModelFullPath As String
Dim TempPartName As String
Dim swModel As SldWorks.ModelDoc2
Dim i As String

Sub main()
    Set swApp = Application.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = swApp.ActiveDoc
    sModelName = swModel.GetPathName
    sModelFullPath = Left(sModelName, Len(sModelName) - 6) & "dwg"
'    TempPartName = Left(sModelName, Len(sModelName) - 6) & "SLDPRT"
    Dim bs As Boolean
    Dim Errors As Long
    Dim Warnings As Long
    bs = swModel.Extension.SaveAs("C:\Users\Omur\AppData\Local\Temp\tempPart.SLDPRT", swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Copy, Nothing, Errors, Warnings)
    Dim swPart As SldWorks.PartDoc
    Set swModel = swApp.OpenDoc6("C:\Users\Omur\AppData\Local\Temp\tempPart.SLDPRT", swDocumentTypes_e.swDocPART, swOpenDocOptions_e.swOpenDocOptions_Silent, "", Errors, Warnings)
    Set swPart = swModel
    Dim alignment(11) As Double
    alignment(0) = 0# ' x origin
    alignment(1) = 0# ' y
    alignment(2) = 0# ' z
    alignment(3) = 0# ' x vector
    alignment(4) = 0#
    alignment(5) = 0#
    alignment(6) = 0# ' y vector
    alignment(7) = 0#
    alignment(8) = 0#
    alignment(9) = 0#
    alignment(10) = 0#
    alignment(11) = 0#
    Dim views(0) As String
'     views(0) = "*geçerli" ' tr
     views(0) = "*current" 'eng
     bs = swPart.ExportToDWG2(sModelFullPath, swModel.GetPathName, swExportToDWG_e.swExportToDWG_ExportAnnotationViews, True, alignment, False, False, 0, views)
     swApp.CloseDoc (swModel.GetPathName)
End Sub

Code: Select all

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawing As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim swDrawPath As String
Dim nErrors As Long
Dim nWarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

swDrawPath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".")) & "DWG"

'Change Template Name and Paper size here
'Set swDrawing = swApp.NewDocument("C:\ProgramData\SOLIDWORKS\SOLIDWORKS 2020\templates\A4 YATAY.drwdot", 12, 0#, 0#)
'Set swDrawing = swApp.NewDocument("C:\ProgramData\SOLIDWORKS\SOLIDWORKS 2020\templates\A4 YATAY.drwdot", swDwgPaperAsize, 0#, 0#)
'Set swDrawing = swApp.NewDocument("C:\ProgramData\SolidWorks\SOLIDWORKS 2020\templates\A4 YATAY.drwdot", swDwgPaperA4size, 0#, 0#)
'Set swDrawing = swApp.NewDocument("C:\ProgramData\SolidWorks\SOLIDWORKS 2020\templates\A4 YATAY.drwdot", 12, 0.297, 0.21)
'Set swDrawing = swApp.NewDocument("C:\ProgramData\SolidWorks\SOLIDWORKS 2020\templates\A4 YATAY.drwdot", 12, 1, 1)
Set swDrawing = swApp.NewDocument("C:\ProgramData\SolidWorks\SOLIDWORKS 2020\templates\Teknik Resim.drwdot", 12, 1, 1)
Set swSheet = swDrawing.GetCurrentSheet()

'Change desired view name here, replace Current Model View with your desired name.
swDrawing.CreateDrawViewFromModelView swModel.GetPathName, "İzometrik", 0, 0, 0

swSheet.SetScale 1, 1, True, True
swDrawing.ViewZoomtofit2
swDrawing.Extension.SaveAs swDrawPath, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings
swApp.CloseDoc swDrawing.GetTitle

End Sub

Code: Select all

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawing As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim swDrawPath As String
Dim nErrors As Long
Dim nWarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

swDrawPath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".")) & "DWG"

'Replace the temp address below with your own address.
Set swDrawing = swApp.NewDocument("C:\ProgramData\SolidWorks\SOLIDWORKS 2020\templates\Teknik Resim.drwdot", 12, 0#, 0#)
Set swSheet = swDrawing.GetCurrentSheet()

'Change desired view name here, replace Current Model View with your desired name.
swDrawing.CreateDrawViewFromModelView swModel.GetPathName, "*İzometrik", 0, 0, 0

swSheet.SetScale 1, 1, True, True
swDrawing.ViewZoomtofit2
swDrawing.Extension.SaveAs swDrawPath, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings
swApp.CloseDoc swDrawing.GetTitle

End Sub