CODEWITHSUNDEEP
vbasolidworks
Eduards
Eduards

Reputation: 68

SOLIDWORKS VBA open drawing of active part

I simply need to open the drawing by using VBA of the active part. Drawing always has the exact same filename and location as the part. What I got is

Option Explicit


Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swSelMgr As SldWorks.SelectionMgr

Dim swDocSpecification As SldWorks.DocumentSpecification

Dim sName As String

Dim longstatus As Long, longwarnings As Long



Sub main()

Set swApp = Application.SldWorks    
Set swDocSpecification = swApp.GetOpenDocSpec("C:\Users\Public\Documents\SOLIDWORKS\SOLIDWORKS 
2017\tutorial\AutoCAD\7550-021.slddrw")

sName = swDocSpecification.FileName

swDocSpecification.DocumentType = swDocDRAWING

swDocSpecification.ReadOnly = True

swDocSpecification.Silent = False

Set swModel = swApp.OpenDoc7(swDocSpecification)

longstatus = swDocSpecification.Error

longwarnings = swDocSpecification.Warning

End Sub

But it doesn't work probably because of the file location which may always be different depending on how the active part is named and where the active part is located.

Could someone please share a function to simply open the associated drawing of the part?

Upvotes: 0

Views: 2295

Answers (1)

JeromeP
JeromeP

Reputation: 553

Try this:

Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.ModelDoc2
    Dim swDocSpecification As SldWorks.DocumentSpecification
    Dim FilePath As String
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then MsgBox "Open an assembly or part": Exit Sub
    If swModel.GetType <> swDocumentTypes_e.swDocASSEMBLY And swModel.GetType <> swDocumentTypes_e.swDocPART Then MsgBox "Open an assembly or part": Exit Sub
    Set swDocSpecification = swApp.GetOpenDocSpec(swModel.GetPathName)
    FilePath = LCase(swModel.GetPathName)
    FilePath = Replace(FilePath, ".sldprt", ".slddrw")
    FilePath = Replace(FilePath, ".sldasm", ".slddrw")
    swDocSpecification.FileName = FilePath
    swDocSpecification.DocumentType = swDocumentTypes_e.swDocDRAWING
    swDocSpecification.ReadOnly = True
    swDocSpecification.Silent = True
    Set swDraw = swApp.OpenDoc7(swDocSpecification)
    swApp.ActivateDoc3 FilePath, False, swRebuildOnActivation_e.swRebuildActiveDoc, Empty
End Sub

Upvotes: 1

Related Questions