3 Replies Latest reply on Aug 28, 2015 8:10 AM by Willie Roelofs

    Auto mate to origin.

    Willie Roelofs

      Hi,

       

      Situation: When I start an assembly and drag in the part or assembly into the graphics area, the part or assembly get's fixed in a random spot.

      Macro: The macro I've created unfixes the component, selects the planes of that component and the assembly and make every plane coincident. Deletes all the mates and fixes the component.

       

      Problem: I don't know how to select the subassembly.

       

      Code:

       

      Dim swApp As SldWorks.SldWorks
      Dim swModel As ModelDoc2
      Dim swExt As ModelDocExtension
      Dim swSelMgr As SldWorks.SelectionMgr
      Dim swComp As SldWorks.Component2
      Dim swAssem As SldWorks.AssemblyDoc
      Dim featMgr As SldWorks.FeatureManager
      Dim myMate As Object
      Dim NaamComp As String
      Dim NaamAssy As String
      Dim LONGSTATUS As Long
      Dim boolstatus As Boolean
      Dim FPlane(2) As Variant
      Dim TPlane(2) As Variant
      Dim RPlane(2) As Variant
      Function PlaneMate(Plane1, Plane2, Component As String, Assembly As String) As Boolean
          
          'Select component's plane
          boolstatus = swModel.Extension.SelectByID2(Plane1 & "@" & Component & "@" & Assembly, "PLANE", 0, 0, 0, True, 1, Nothing, 0)
          'Select assembly's plane
          boolstatus = swModel.Extension.SelectByID2(Plane2, "PLANE", 0, 0, 0, True, 1, Nothing, 0)
          'Make planes coincident
          Set myMate = swModel.AddMate5(0, 0, False, 0.382753349352431, 0, 0, 0.001, 0.001, 0, 0.5235987755983, 0.5235987755983, False, False, 0, LONGSTATUS)
          'Selecteren ongedaan maken
          swModel.ClearSelection2 True
      
      End Function
      Function DeleteAllMates()
          
          For i = 1 To 25
              'Select mates
              boolstatus = swModel.Extension.SelectByID2("Coincident" & i, "MATE", 0, 0, 0, False, 0, Nothing, 0)
              'Deleting mate
              swModel.EditDelete
          Next i
          
      End Function
      Sub main()
      
          Set swApp = Application.SldWorks
          Set swModel = swApp.ActiveDoc
          Set swExt = swModel.Extension
          Set swSelMgr = swModel.SelectionManager
          Set featMgr = swModel.FeatureManager
          Set swAssem = swModel
          
          NaamAssy = swModel.GetTitle
          
          'Look up first component in the list
          vComponents = swAssem.GetComponents(True)
          Set swComp = vComponents(0)
          
          'Select component and make it float.
          boolstatus = swComp.Select2(True, 1)
          NaamComp = swComp.Name2
          swAssem.UnfixComponent
          
          'Every name ever used to name planes.
          FPlane(0) = "Front Plane"
          FPlane(1) = "XY Plane"
          FPlane(2) = "Front"
          RPlane(0) = "Right Plane"
          RPlane(1) = "YZ Plane"
          RPlane(2) = "Right"
          TPlane(0) = "Top Plane"
          TPlane(1) = "XZ Plane"
          TPlane(2) = "Top"
          
          For j = 0 To 2
              For k = 0 To 2
                  'Mating the planes
                  boolstatus = PlaneMate(FPlane(j), FPlane(k), NaamComp, NaamAssy)
                  boolstatus = PlaneMate(RPlane(j), RPlane(k), NaamComp, NaamAssy)
                  boolstatus = PlaneMate(TPlane(j), TPlane(k), NaamComp, NaamAssy)
              Next k
          Next j
          
          'Fixating component.
          boolstatus = swComp.Select2(True, 1)
          swAssem.FixComponent
      
          DeleteAllMates
          
          MsgBox ("Macro voltooid")
      
      End Sub