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