I misspoke (slightly). The FindReferences functionality isn’t exactly available via the API (there is an Enhancement Request for it). I use PDM which does have this functionality. Without PDM, you have two options.
If you have an active SW subscription, you can get a DocumentManager API license key and you can use the GetExternalFeatureReferences3 function. The nice part about the document manager API is that you don’t have to open the document in SOLIDWORKS to get the reference information or to check the custom properties.
This simple example will get an array of names of the referenced documents for the file in the ‘path’ variable. The array elements are then put into a collection which will eliminate any duplicates. Then each element in the collection is checked to see if the Print_3D custom property is ‘Yes’.
Dim swApp As SldWorks.SldWorks
Dim factory As SwDMClassFactory
Dim dmApp As SwDMApplication4
Dim doc As SwDMDocument30
Const key = "your document manager license key"
Const path = "path to document"
Dim errors As SwDmDocumentOpenError
Dim refOption As SwDMExternalReferenceOption2
Dim searchOption As SwDMSearchOption
Dim refCount As Long
Dim refNames As Variant
Dim foundNames As New Collection
Sub main()
Set swApp = Application.SldWorks
Set factory = New SwDMClassFactory
Set dmApp = factory.GetApplication(key)
Set doc = dmApp.GetDocument(path, swDmDocumentAssembly, True, errors)
Set refOption = dmApp.GetExternalReferenceOptionObject2
refOption.NeedSuppress = True
refOption.Configuration = "DEFAULT"
Set searchOption = dmApp.GetSearchOptionObject
searchOption.SearchFilters = SwDmSearchFilters.SwDmSearchExternalReference
refOption.searchOption = searchOption
refCount = doc.GetExternalFeatureReferences3(refOption)
refNames = refOption.ExternalReferences
For i = LBound(refNames) To UBound(refNames)
If Not Contains(foundNames, refNames(i)) Then 'Prevent duplicates
foundNames.Add refNames(i), refNames(i)
End If
Next i
For Each foundName In foundNames
Dim docPath As String
docPath = foundName
ProcessDocument docPath
Next
End Sub
Sub ProcessDocument(docPath As String)
Dim doc As SwDMDocument30
Dim errors As SwDmDocumentOpenError
Set doc = dmApp.GetDocument(docPath, GetDocType(docPath), True, errors)
If doc.GetCustomPropertyCount = 0 Then
Exit Sub
End If
Dim print3D As String
Dim names() As String
names = doc.GetCustomPropertyNames
print3D = doc.GetCustomProperty2("3D_Print", swDmCustomInfoYesOrNo)
If (print3D = "Yes") Then
Debug.Print docPath & " has 3D_Print enabled"
End If
End Sub
Function GetDocType(docPath As String) As SwDmDocumentType
Dim fs As FileSystemObject
Set fs = CreateObject("Scripting.FileSystemObject")
Select Case fs.GetExtensionName(docPath)
Case "sldprt"
GetDocType = swDmDocumentPart
Case "sldasm"
GetDocType = swDmDocumentAssembly
End Select
End Function
Function Contains(col As Collection, key As Variant) As Boolean
Dim obj As Variant
On Error GoTo err
Contains = True
obj = col(key)
Exit Function
err:
Contains = False
End Function
If you can’t use the document manager API, you can get the list of references from the IAdvancedSaveAsOptions object returned from the ModelDocExtension::GetAdvancedSaveAsOptions method. Something like this:
Dim swApp As SldWorks.SldWorks
Dim mDoc As ModelDoc2
Dim mExt As ModelDocExtension
Dim saveOptions As AdvancedSaveAsOptions
Sub main()
Set swApp = Application.SldWorks
Set mDoc = swApp.ActiveDoc
Set mExt = mDoc.Extension
Set saveOptions = mExt.GetAdvancedSaveAsOptions(0)
Dim ids As Variant
Dim names As Variant
Dim paths As Variant
saveOptions.GetItemsNameAndPath ids, names, paths
For i = LBound(names) To UBound(names)
If names(i) <> mDoc.GetTitle Then
ProcessDocument (paths(i) & "\" & names(i))
End If
Next i
End Sub
Sub ProcessDocument(docPath As String)
docPath = Replace(docPath, " [Not Open]", "")
Dim doc As ModelDoc2
Dim docExt As ModelDocExtension
Dim retval As Long
Dim propMgr As CustomPropertyManager
Dim errors As Long
Set doc = swApp.OpenDocSilent(docPath, GetDocType(docPath), errors)
Set docExt = doc.Extension
Set propMgr = docExt.CustomPropertyManager("")
If propMgr.Count = 0 Then
swApp.CloseDoc docPath
Exit Sub
End If
Dim val As String
Dim resolvedVal As String
Dim wasResolved As Boolean
retval = propMgr.Get6("3D_Print", False, val, resolvedVal, wasResolved, False)
If (resolvedVal = "Yes") Then
Debug.Print docPath & " has 3D_Print enabled"
End If
swApp.CloseDoc docPath
End Sub
Function GetDocType(docPath As String) As swDocumentTypes_e
Dim fs As FileSystemObject
Set fs = CreateObject("Scripting.FileSystemObject")
Select Case LCase(fs.GetExtensionName(docPath))
Case "sldprt"
GetDocType = swDocPART
Case "sldasm"
GetDocType = swDocASSEMBLY
End Select
End Function