1 Reply Latest reply on Aug 21, 2017 10:34 AM by Manikandan Babu

    How to select and name a Face

    Kei Luong

      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

        • Re: How to select and name a Face
          Manikandan Babu

          Hi Kei,

           

          Debug the code when Assembly has mates.

           

          Dim swApp As SldWorks.SldWorks

          Dim swmodel As SldWorks.ModelDoc2

          Dim swfeat As SldWorks.Feature

          Dim Swmatefeat As SldWorks.Feature

          Dim swmate As SldWorks.Mate2

          Dim Vfaces As Variant

          Dim SwMateEnt1 As SldWorks.MateEntity2

          Dim SwMateEnt2 As SldWorks.MateEntity2

          Dim Swent1 As SldWorks.Entity

          Dim Swent2 As SldWorks.Entity

          Sub main()

           

           

          Set swApp = Application.SldWorks

          Set swmodel = swApp.ActiveDoc

          Set swassm = swmodel

          Set swfeat = swmodel.FirstFeature

               Do While Not swfeat Is Nothing

                    If swfeat.Name = "Mates" Then

                    Set Swmatefeat = swfeat.GetFirstSubFeature

                         Do While Not Swmatefeat Is Nothing

                         Debug.Print Swmatefeat.Name

                         Set swmate = Swmatefeat.GetSpecificFeature2

                         Set SwMateEnt1 = swmate.MateEntity(0)

                         Set Swent1 = SwMateEnt1.Reference     'Mated Face Entity 1

                         Swent1.Select True

                         swmodel.ViewZoomToSelection

                         swmodel.ClearSelection2 True

                         Set SwMateEnt2 = swmate.MateEntity(1)

                         Set Swent2 = SwMateEnt2.Reference  'Mated Face Entity 2

                         Swent2.Select True

                         swmodel.ViewZoomToSelection

                         Set Swmatefeat = Swmatefeat.GetNextSubFeature

                         Loop

                    End If

                 Set swfeat = swfeat.GetNextFeature

                 Loop

          End Sub

           

          Manikandan