CAD Forum

Code: Select all

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelExt As SldWorks.ModelDocExtension
Dim swSelMgr As SldWorks.SelectionMgr
Dim selGtol As SldWorks.Gtol
Dim idx As Long
Dim params As Variant
Dim arrSymbols As Variant
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swModelExt = swModel.Extension
    Set swSelMgr = swModel.SelectionManager
    Set selGtol = swSelMgr.GetSelectedObject6(1, 0)
    Debug.Print "GetTextCount = " & CStr(selGtol.GetTextCount)
Dim gTOLcoll As New Collection
    For idx = 0 To selGtol.GetTextCount - 1
        gTOLcoll.Add selGtol.GetTextAtIndex(idx)
        Debug.Print "GetTextAtIndex(" & CStr(idx) & ") = " & selGtol.GetTextAtIndex(idx)
    Next idx
    Debug.Print "GetFrameCount = " & (CStr(selGtol.GetFrameCount) - 1)
    For idx = 1 To selGtol.GetFrameCount - 1
        params = selGtol.GetFrameValues(idx)
        Debug.Print "GetFrameValues(" & CStr(idx) & ") = " & params(0) & "," & params(1) & "," & params(2) & "," & params(3) & "," & params(4)
        arrSymbols = selGtol.GetFrameSymbols3(idx)
        Debug.Print "  GetFrameSymbols3(" & CStr(idx) & ") = " & arrSymbols(0) & ", " & arrSymbols(1) & ", " & arrSymbols(2) & ", " & arrSymbols(3) & ", " & arrSymbols(4) & ", " & arrSymbols(5) & ")"
   Next idx
   
    Dim count As Integer
    
    Dim tol1 As String
    Dim tol2 As String
    Dim item As Variant
    Dim nomTolPassed As Boolean
    nomTolPassed = False
    
    params = selGtol.GetFrameValues(1)
    arrSymbols = selGtol.GetFrameSymbols3(1)
    gTOLcoll.Remove 1                                               'Remove gTOL symbol from collection
    If arrSymbols(5) <> "" Then gTOLcoll.Remove gTOLcoll.count      'Remove Datum 3 modifier from collection
    If params(4) <> "" Then gTOLcoll.Remove gTOLcoll.count          'Remove Datum 3 from collection
    If arrSymbols(4) <> "" Then gTOLcoll.Remove gTOLcoll.count      'Remove Datum 2 modifier from collection
    If params(3) <> "" Then gTOLcoll.Remove gTOLcoll.count          'Remove Datum 2 from collection
    If arrSymbols(3) <> "" Then gTOLcoll.Remove gTOLcoll.count      'Remove Datum 1 modifier from collection
    If params(2) <> "" Then gTOLcoll.Remove gTOLcoll.count          'Remove Datum 1 from collection
    
    'Now we should be left with Tolerance 1 and/or Tolerance 2 values. I'm assuming Tolerance 1 exists.
    'Get Tolerance 1
    If params(0) <> "" Then
        For Each item In gTOLcoll
            If count = 0 And (item = "<MOD-DIAM>" Or item = "<MOD-SPHDIA>") Then
                tol1 = tol1 & CStr(item)
                gTOLcoll.Remove 1
                count = count + 1
            ElseIf IsNumeric(item) Then
                tol1 = tol1 & CStr(item)
                gTOLcoll.Remove 1
                nomTolPassed = True
            ElseIf count > 0 And nomTolPassed Then
                If item = "<MOD-DIAM>" Or item = "<MOD-SPHDIA>" Or IsNumeric(item) Then
                    Exit For
                Else
                    tol1 = tol1 & CStr(item)
                    gTOLcoll.Remove 1
                End If
            End If
        Next item
        count = 0
    End If
    
    'Get Tolerance 2
    If params(1) <> "" Then
        For Each item In gTOLcoll
            If count = 0 And (item = "<MOD-DIAM>" Or item = "<MOD-SPHDIA>") Then
                tol2 = tol2 & CStr(item)
                gTOLcoll.Remove 1
                count = count + 1
            ElseIf IsNumeric(item) Then
                tol2 = tol2 & CStr(item)
                gTOLcoll.Remove 1
                nomTolPassed = True
            ElseIf count > 0 And nomTolPassed Then
                If item = "<MOD-DIAM>" Or item = "<MOD-SPHDIA>" Or IsNumeric(item) Then
                    Exit For
                Else
                    tol2 = tol2 & CStr(item)
                    gTOLcoll.Remove 1
                End If
            End If
        Next item
    End If
    Debug.Print tol1
    Debug.Print tol2        
End Sub

Function ToCollection(a As Variant) As Collection
    Dim c As New Collection
    For Each item In a
      c.Add item
    Next item
    Set ToCollection = c
End Function

Code: Select all

Frame 1 start
	================== Has Diameter Symbol =================
	True
	True
	================== Frame Symbols =================
	<GTOL-PERP>
	<MOD-MMC>
	<MOD-LMC>
	<MOD-LMC>
	<MOD-MMC>
	<MOD-LMC>
	================== Frame Values =================
	0
	.05 MAX
	A<MOD-LMC>
	B<MOD-MMC>
	C<MOD-LMC>
Frame 1 end