AnsweredAssumed Answered

How to select and name a Face

Question asked by Kei Luong on Aug 18, 2017
Latest reply on Aug 21, 2017 by Manikandan Babu

Hi everyone,

I'm writing a macro that could grab components and add mates to them in the assembly. I already have add mates to components part but still can't figure out how to grab and name the face of components. Could anyone please give me some advises.Any help is greatly appreciated and thank you so much. Below is my code attached for referencing.

 

' This Macro will automatically pick the faces from components and add coincident mates to the assembly

Dim swApp As SldWorks.SldWorks

Dim swDoc As SldWorks.ModelDoc2

Dim swAssy As SldWorks.AssemblyDoc

Dim swSelMgr As SldWorks.SelectionMgr

Dim swMate As SldWorks.Mate2

Dim ErrorLong As Long

Dim MsgReply As Integer

Dim NewAlign As Long

Dim swPart As SldWorks.PartDoc

Dim retval As Variant

Dim swFaceName As String

Dim selFace As SldWorks.Face2

Dim swFace As SldWorks.Face2

Sub main()

Set swApp = Application.SldWorks

Set swDoc = swApp.ActiveDoc

Set swAssy = swDoc

Set swSelMgr = swDoc.SelectionManager

' This part will add coincident mates to the selected entity(faces)

If swDoc.GetType <> swDocASSEMBLY Then

    MsgBox "Use this macro in Assembly documents only.", vbCritical

    Exit Sub

End If

If swSelMgr.GetSelectedObjectCount <> 2 Then

    MsgBox swSelMgr.GetSelectedObjectCount & " items selected.  Req'd number is 2.", vbCritical

    Exit Sub

End If

Set swMate = swAssy.AddMate3(swMateCOINCIDENT, swMateAlignCLOSEST, False, 0, 0, 0, 0, 0, 0, 0, 0, False, ErrorLong)

If Nothing Is swMate Then

    MsgBox "Mating Error #" & ErrorLong & " Mate not added.", vbCritical

    Exit Sub

End If

If swAddMateError_OverDefinedAssembly = ErrorLong Then

    MsgReply = MsgBox("Overdefining mate.  Keep anyway?", vbYesNo + vbQuestion)

    If vbNo = MsgReply Then

        swDoc.ClearSelection2 True

        swMate.Select True

        swDoc.Extension.DeleteSelection2 0

    Else

        'swDoc.EditRebuild3

    End If

ElseIf swMate.Alignment <> swMateAlignCLOSEST Then

    MsgReply = MsgBox("Keep current alignment?", vbYesNo, "Mate Alignment")

   

    If vbNo = MsgReply Then

        If swMate.Alignment = swMateAlignALIGNED Then

            NewAlign = swMateAlignANTI_ALIGNED

        Else

            NewAlign = swMateAlignALIGNED

        End If

        swMate.Select True

        swAssy.EditMate2 swMateCOINCIDENT, NewAlign, False, 0, 0, 0, 0, 0, 0, 0, 0, ErrorLong

        If swAddMateError_OverDefinedAssembly = ErrorLong Then

            MsgReply = MsgBox("Flip caused errors.  Undo?", vbYesNo + vbQuestion)

            If vbYes = MsgReply Then

                swDoc.EditUndo2 1

            End If

        End If

        'swDoc.EditRebuild3

    End If

ElseIf swAddMateError_NoError <> ErrorLong Then

    MsgBox "Mate error #" & ErrorLong & vbCrLf & "Mate not added"

    If Not swMate Is Nothing Then

        swDoc.ClearSelection2 True

        swMate.Select True

        swDoc.Extension.DeleteSelection2 0

    End If

ElseIf swMate.GetErrorCode <> swFeatureErrorNone Then

    Select Case swMate.GetErrorCode

        Case swFeatureErrorMateInvalidEdge

            MsgBox "Invalid edge"

        Case swFeatureErrorMateInvalidFace

            MsgBox "Invalid Face"

        Case swFeatureErrorMateFailedCreatingSurface

            MsgBox "Mate surface type not supported"

        Case swFeatureErrorMateInvalidEntity

            MsgBox "Supressed, Invalid, or Missing Entity"

        Case swFeatureErrorMateDanglingGeometry

            MsgBox "Mate geometry is dangling"

        Case swFeatureErrorMateEntityNotLinear

            MsgBox "Non-linear edges cannot be used for mating"

        Case swFeatureErrorMateOverdefined

            MsgBox "Mate is overdefining"

        Case swFeatureErrorMateIlldefined

            MsgBox "Mate cannot be solved (Ill-Defined)"

        Case swFeatureErrorMateBroken

            MsgBox "One or more entities suppressed or invalid for this mate"

    End Select

    swDoc.ClearSelection2 True

    swMate.Select True

    swDoc.Extension.DeleteSelection2 0

End If

swDoc.ClearSelection2 True

End Sub

Outcomes