Open Drawing macro

For what it's worth, here's a macro I've been finding useful.

It takes the place of the Open Drawing function when right-clicking on
a part or assembly in the feature manager. I've been frustrated with
SWX in the past with multiple drawing files created from a single part
or assembly file and each linked to a configuration, since the Open
Drawing function only looks for drawing files with the same name as
the part or assembly file. So this macro looks at the "Part number to
be displayed in the BOM" in the configuration properties and tries to
find a file with that name to open before defaulting to the standard
Open Drawing behavior. So each configuration can have its own
drawing, you just name it the same as the BOM part number. I was
using the hyperlinked note technique for this problem, but I think
this is a little easier.

Be sure to import swconst.bas to the macro project.

Eric



Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Public Function stripPath(ByVal stringToModify As String) As String
'functions strips the path and file extension by removing
'anything to the left of "\" character and right of the "." character

Dim index As Long

If stringToModify = "" Then 'true if the file hasn't been save yet
stripPath = stringToModify
Exit Function
End If
stringToModify = StrReverse(stringToModify)
index = InStr(1, stringToModify, "\", vbTextCompare) - 1
If index > 0 Then stringToModify = Left(stringToModify, index)
index = InStr(1, stringToModify, ".", vbTextCompare)
stringToModify = StrReverse(stringToModify)
If index > 0 Then stringToModify = Left(stringToModify,
Len(stringToModify) - index)
stripPath = stringToModify

End Function
Public Function getPath(ByVal stringToModify As String) As String
'gets the path

Dim index As Long

getPath = ""
If stringToModify = "" Then Exit Function
stringToModify = StrReverse(stringToModify)
index = InStr(1, stringToModify, "\", vbTextCompare) - 1
If index > 0 Then stringToModify = Right(stringToModify,
Len(stringToModify) - index)
getPath = StrReverse(stringToModify)

End Function

Public Function docAintDrawing() As Boolean
'make sure the current document is a part or assembly

If swModel Is Nothing Then
swApp.SendMsgToUser ("Please open a part or assembly document
first.")
docAintDrawing = False
ElseIf swModel.GetType() = swDocPART Or swModel.GetType =
swDocASSEMBLY Then
docAintDrawing = True
Else
swApp.SendMsgToUser ("Please open a part or assembly document
first.")
docAintDrawing = False
End If

End Function



Sub main()

Dim swConfig As SldWorks.Configuration
Dim fileName As String
Dim theName As String
Dim Errors As Long
Dim Warnings As Long

Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc

If Not docAintDrawing Then
Exit Sub
End If

Set swConfig = swModel.GetActiveConfiguration

fileName = swModel.GetPathName

swApp.SetCurrentWorkingDirectory getPath(fileName)
fileName = stripPath(fileName)

Errors = -9009
If swConfig.UseAlternateNameInBOM And swConfig.alternateName = "" Then
'try to open the configuration name
swApp.OpenDoc6 swConfig.Name & ".SLDDRW", swDocDRAWING,
swOpenDocOptions_Silent, "", Errors, Warnings
End If
If Errors = -9009 Or Errors <> 0 Then
If swConfig.UseAlternateNameInBOM And swConfig.alternateName <> ""
Then 'try to open a file with the user supplied name
swApp.OpenDoc6 swConfig.alternateName & ".SLDDRW",
swDocDRAWING, swOpenDocOptions_Silent, "", Errors, Warnings
End If
End If
If Errors = -9009 Or Errors <> 0 Then
swApp.OpenDoc6 fileName & ".SLDDRW", swDocDRAWING,
swOpenDocOptions_Silent, "", Errors, Warnings
End If

If Errors = swFileNotFoundError Then
swApp.SendMsgToUser "Can't find a file with name, go find it
yourself."
End If

Set swApp = Nothing
Set swModel = Nothing
Set swConfig = Nothing

End Sub