Generates DWG in current view from attached macro assembly file. It works fine for me, I hope someone makes more advanced versions.
Special thanks to @Rob Edwards
Create Part from Assembly
Save to temp folder
Open and save current view as DWG
-SW 2020 sp3-
Replace the temp file path with your own file path.
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
