Lesson 3.3 code - with error handling

Files

Lesson 3.3 code - with error handling

Code

'Precondition: part has 3 configurations, a doc-level custom prop called "Author" and _
    "PartNo" and no other custom properties
    
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim vCustPropNames As Variant
Dim strValue As String
Dim strResolved As String
Dim vConfigNames As Variant
    
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    If Not swModel Is Nothing Then
        If swModel.GetType = swDocPART Then
            'Access custom properties at document-level
            Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
            vCustPropNames = swCustPropMgr.GetNames
            If IsEmpty(vCustPropNames) = False Then
                If swCustPropMgr.Add2("Description", swCustomInfoText, "Intake ring") = False Then
                    Debug.Print "Could not add Description. Custom property may already exist."
                End If
                swCustPropMgr.Set "Author", "JD"
                swCustPropMgr.Get3 "PartNo", True, strValue, strResolved
                swCustPropMgr.Delete "PartNo"
            End If
            
            'Access custom properties at configuration level
            vConfigNames = swModel.GetConfigurationNames
            Dim i As Integer
            For i = 0 To UBound(vConfigNames)
                Set swCustPropMgr = swModel.Extension.CustomPropertyManager(vConfigNames(i))
                swCustPropMgr.Add2 "PartNo", swCustomInfoText, strValue & "-" & vConfigNames(i)
                swCustPropMgr.Add2 "Material", swCustomInfoText, _
                    Chr(34) & "SW-Material@" & FullTitle & Chr(34)
            Next i
        Else
            MsgBox "Please open a part."
        End If
    Else
        MsgBox "Please open a part."
    End If
End Sub
    
'Get the doc title including extension
Function FullTitle() As String
    Dim strPathName As String
    strPathName = swModel.GetPathName
    FullTitle = Right(strPathName, Len(strPathName) - InStrRev(strPathName, "\"))
End Function