Get Cosmetic Threads Features in a Part Document (VBA)

This example shows how to get cosmetic thread features, mirrored and patterned, in a part document.

 

' --------------------------------------------------------------------------

'

' Preconditions: Part document is open and contains mirrored

'                and patterned cosmetic thread features.

'

' Postconditions: None

'

' --------------------------------------------------------------------------

Option Explicit

 

Dim swApp As SldWorks.SldWorks

Dim swMathUtility As SldWorks.MathUtility

 

Sub main()

 

    Dim myModel As SldWorks.ModelDoc2

    Dim thisFeature As SldWorks.Feature

    Dim thisSubFeature As SldWorks.Feature

    Set swApp = Application.SldWorks

    Set swMathUtility = swApp.GetMathUtility()

    Set myModel = swApp.ActiveDoc

    myModel.ClearSelection2 True

    ' Traverse features and subfeatures of this model and look for cosmetic threads

    Set thisFeature = myModel.FirstFeature

    While Not thisFeature Is Nothing

        Debug.Print "Processing " & thisFeature.Name

        Set thisSubFeature = thisFeature.GetFirstSubFeature()

        While Not thisSubFeature Is Nothing

            Debug.Print "   Processing sub " & thisSubFeature.Name

            If (thisSubFeature.GetTypeName() = "CosmeticThread") Then

                Call processCosmeticThread(myModel, thisSubFeature)

            End If

            Set thisSubFeature = thisSubFeature.GetNextSubFeature()

        Wend

        Set thisFeature = thisFeature.GetNextFeature()

    Wend

End Sub

 

Private Sub processCosmeticThread(myModel As SldWorks.ModelDoc2, aFeature As SldWorks.Feature)

    Dim thisCThread As SldWorks.CosmeticThreadFeatureData

    Dim patternedCount As Long

    Dim boolstatus As Boolean

    Dim myComponent As SldWorks.Component2

    Dim holeEdge As SldWorks.Edge

    Dim holeCurve As SldWorks.Curve

    Dim vCurveParams As Variant

    Dim basePt(0 To 2) As Double

    Dim vBasePt As Variant

    Dim mBasePt As SldWorks.MathPoint

    Dim edgeEntity As SldWorks.Entity

    Dim selData As SldWorks.SelectData

    Dim vPatternedXform As Variant

    Dim i As Integer

    Dim transform As SldWorks.MathTransform

    Dim mTransPt As SldWorks.MathPoint

    Dim vTransPt As Variant

    Dim transPtX As Double, transPtY As Double, transPtZ As Double

    Dim append As Boolean, myCallout As SldWorks.Callout

 

    Set thisCThread = aFeature.GetDefinition()

 

    If Not thisCThread Is Nothing Then

    ' Retrieve the information about the edge associated with the cosmetic thread

        boolstatus = thisCThread.AccessSelections(myModel, myComponent)

        Set holeEdge = thisCThread.Edge()

        If Not holeEdge Is Nothing Then

            Set holeCurve = holeEdge.GetCurve()

            If Not holeCurve Is Nothing Then

                vCurveParams = holeEdge.GetCurveParams2()

                basePt(0) = vCurveParams(0)

                basePt(1) = vCurveParams(1)

                basePt(2) = vCurveParams(2)

                Debug.Print "        0 (" & Format(basePt(0), "###0.0#####") & ", " & Format(basePt(1), "###0.0#####") & ", " & Format(basePt(2), "###0.0#####") & ")"

            End If

        End If

        thisCThread.ReleaseSelectionAccess

        vBasePt = basePt

        Set mBasePt = swMathUtility.CreatePoint((vBasePt))

        ' Select the edge used for the cosmetic thread

        Set edgeEntity = holeEdge

        append = True

        boolstatus = edgeEntity.Select4(append, selData)

        ' Retrieve information about any patterns made from this cosmetic thread

        patternedCount = thisCThread.GetPatternedTransformsCount()

        Debug.Print "      Pattern count = " & patternedCount

        vPatternedXform = thisCThread.PatternedTransforms()

        If Not IsEmpty(vPatternedXform) Then

            For i = LBound(vPatternedXform) To UBound(vPatternedXform)

                Set transform = vPatternedXform(i)

                Set mTransPt = mBasePt.MultiplyTransform(transform)

                vTransPt = mTransPt.ArrayData()

                transPtX = vTransPt(0)

                transPtY = vTransPt(1)

                transPtZ = vTransPt(2)

                Debug.Print "       " & Str(i + 1) & " (" & Format(transPtX, "###0.0#####") & ", " & Format(transPtY, "###0.0#####") & ", " & Format(transPtZ, "###0.0#####") & ")"

' The transform information should be sufficient

' for getting the necessary geometry

' information regarding this cosmetic thread and

' its patterned cosmetic threads. The next step

' attempts to select the edge used for patterned

' cosmetic threads to help verify that the

' transform information is accurate, and that

' an edge could be obtained if necessary.

' Selections may not always work depending on

' if the edge is actually visible in this

' orientation and this display state.

                append = True

                boolstatus = myModel.Extension.SelectByID2("", "EDGE", transPtX, transPtY, transPtZ, append, 0, myCallout, 0)

                If (boolstatus = 0) Then

                    Debug.Print "         Selection Failed?"

                End If

            Next i

        End If

    End If

End Sub