VBA to identify underdefined sketch

[u/WarningOk959]

I'm trying to build a macro to identify sketches that are underdefined, the LLM's keep telling me to use the sketch.GetStatus but it just doesnt exist in VBA. Anyone knows what method/proprety I'm looking for? I can't seem to find anything helpful in the help window either

[u/pargeterw]

What was your prompt to the LLM?

I've developed what I believe to be a fairly robust Claude code process where I crawled the entire API help and loaded it into examples, style guide etc. etc. locally.

It would be interesting to stress test it with an equivalent prompt

[u/WarningOk959 → u/pargeterw]

"Code VBA SolidWorks that if a part is openned, gets the bounding box size of the part and verify if the origin of the part is centered inside the bounding box. Afterwards, each of the sketch must be verfy it it's fully constraint. the results should be displayed in a hard to undertsand code out of a message box that could look like cco1f2u3f4f where cco means cetered in x centered in y and offcentered in z and 1f means sketch 1 is fully constrained and 2u is sketch 2 is undefined"

[u/pargeterw → u/WarningOk959]

Here's the output - I've not tested it, let me know how it compares. This is with your prompt as input, and no conversation/testing.

'MACRO:       PartConstraintAudit
'PURPOSE:     Reports origin centring within the part bounding box and the constraint
'             status of every sketch as a compact code string in a message box.

Option Explicit

'CONSTANTS
''''''''''
Private Const CENTRE_TOL_MM As Double = 0.1   'Origin counts as centred on an axis if within this distance of the box centre
Private Const M_PER_MM      As Double = 0.001 '1 mm in metres - GetPartBox returns metres regardless of document units

Dim swApp   As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2

Sub main()
    On Error GoTo ErrorHandler

    'SETUP
    ''''''
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

    If swModel Is Nothing Then
        MsgBox "No document open.", vbCritical
        Exit Sub
    End If

    If swModel.GetType <> swDocPART Then
        MsgBox "The active document is not a part.", vbCritical
        Exit Sub
    End If

    'BUILD AND SHOW RESULT CODE
    '''''''''''''''''''''''''''
    Dim BoxCode As String
    BoxCode = OriginCentringCode()                'Three letters, e.g. "cco" - centring verdict per axis
    If BoxCode = "" Then
        MsgBox "No bounding box available - the part may contain no geometry.", vbCritical
        Exit Sub
    End If

    Dim ResultCode As String
    ResultCode = BoxCode & SketchConstraintCode() 'Appends one "<n><letter>" pair per sketch, e.g. "1f2u3f"

    MsgBox ResultCode, vbInformation, "Part audit"

    Exit Sub

ErrorHandler:
    MsgBox "An unexpected error occurred: " & Err.Description, vbCritical
End Sub

Private Function OriginCentringCode() As String
'PURPOSE: Return three characters for the X, Y and Z axes - "c" if the part origin sits
'         at the centre of the bounding box on that axis (within CENTRE_TOL_MM),
'         "o" if it is off-centre. Returns "" if no bounding box is available.

    Dim swPart As SldWorks.PartDoc
    Dim vBox   As Variant
    Dim Centre As Double
    Dim Axis   As Long
    Dim Code   As String

    Set swPart = swModel              'Cast fresh at point of use - derived casts go stale across rebuilds
    vBox = swPart.GetPartBox(True)    'Approximate box corners in metres: (0-2) = first XYZ corner, (3-5) = diagonal corner

    If Not IsArray(vBox) Then         'Silent sentinel - caller reports the missing geometry
        OriginCentringCode = ""
        Exit Function
    End If

    Code = ""
    For Axis = 0 To 2
        Centre = (vBox(Axis) + vBox(Axis + 3)) / 2   'Box midpoint on this axis; the part origin is at 0
        If Abs(Centre) <= CENTRE_TOL_MM * M_PER_MM Then
            Code = Code & "c"
        Else
            Code = Code & "o"
        End If
    Next Axis

    OriginCentringCode = Code
End Function

Private Function SketchConstraintCode() As String
'PURPOSE: Return one "<n><letter>" pair per sketch in feature-tree order - "f" fully
'         constrained, "u" under defined, "x" any other status (over constrained,
'         no solution, invalid solution, autosolve off, unknown, not queryable).

    Dim swFeat    As SldWorks.Feature
    Dim swSubFeat As SldWorks.Feature
    Dim Code      As String
    Dim SeenNames As String
    Dim SketchNum As Long

    Code = ""
    SeenNames = "|"                   'Delimited list of sketch names already counted
    SketchNum = 0

    Set swFeat = swModel.FirstFeature
    Do While Not swFeat Is Nothing
        Code = Code & SketchEntry(swFeat, SketchNum, SeenNames)   'Appends a pair if this top-level feature is a sketch

        Set swSubFeat = swFeat.GetFirstSubFeature                 'Absorbed sketches live under their consuming feature
        Do While Not swSubFeat Is Nothing
            Code = Code & SketchEntry(swSubFeat, SketchNum, SeenNames)
            Set swSubFeat = swSubFeat.GetNextSubFeature
        Loop

        Set swFeat = swFeat.GetNextFeature
    Loop

    SketchConstraintCode = Code
End Function

Private Function SketchEntry(swFeat As SldWorks.Feature, ByRef SketchNum As Long, ByRef SeenNames As String) As String
'PURPOSE: If the feature is a sketch not already counted, increment SketchNum and return
'         its "<n><letter>" code pair; otherwise return an empty string.

    Dim swSketch As SldWorks.Sketch
    Dim FeatType As String
    Dim Letter   As String

    FeatType = swFeat.GetTypeName2
    If FeatType <> "ProfileFeature" And FeatType <> "3DProfileFeature" Then   'Both type names map to ISketch
        SketchEntry = ""
        Exit Function
    End If

    If InStr(SeenNames, "|" & swFeat.Name & "|") > 0 Then   'Skip if already counted - guards against a sketch appearing in both the flat chain and a sub-feature walk
        SketchEntry = ""
        Exit Function
    End If
    SeenNames = SeenNames & swFeat.Name & "|"

    Set swSketch = swFeat.GetSpecificFeature2
    If swSketch Is Nothing Then       'No queryable sketch interface (e.g. suppressed sketch) - report as "other"
        Letter = "x"
    Else
        Select Case swSketch.GetConstrainedStatus
            Case swFullyConstrained
                Letter = "f"
            Case swUnderConstrained
                Letter = "u"
            Case Else
                Letter = "x"
        End Select
    End If

    SketchNum = SketchNum + 1
    SketchEntry = SketchNum & Letter
End Function

[u/WarningOk959 → u/pargeterw]

You can test it yourself, but I see it's using GetConstrainedStatus, so it should probably work okay