4 Replies Latest reply on Mar 11, 2013 4:40 AM by Chris Day

    Body-Move/Copy VBA Help needed (SelectByID2 with Face?)

    Chris Day

      I'm trying to apply the Move/Copy command on a single-bodied part (attached). I saved my commands with the macro recorder and am trying to edit the code to work generally.

       

      What I'm having trouble with is selecting the face of the body. I've been fiddling with the code for ages trying various things, but nothing is working. Any help would be appreciated.

       

      The code below is what I'm working on. It can be pasted into an empty module if neccessary. The first bit of code finds the largest face and I tried to squeeze this in to the Move/Copy code in every way I could imagine but nothing seeems to work. I'm not really sure what the best way forward is. 

       

      Private Sub AfterCreation()

          Dim swSelMgr As SldWorks.SelectionMgr

          Dim swBody As SldWorks.Body2

          Dim swFace As SldWorks.Face2

          Dim swEntity As SldWorks.Entity

          Dim swSelData As SldWorks.SelectData

          Dim swModExt As SldWorks.ModelDocExtension

          Dim Faces As Variant

          Dim Body As Variant

          Dim swPart As SldWorks.ModelDoc2

          Dim swComponent As SldWorks.Component2

       

          Dim swApp As SldWorks.SldWorks     

          Dim swModel As SldWorks.ModelDoc2  

          Set swApp = Application.SldWorks   

          Set swModel = swApp.ActiveDoc      

       

          Set swPart = swModel

          Set swModExt = swModel.Extension

          Set swSelMgr = swModel.SelectionManager

       

          ' Find face with largest surface area to align with front plane

          Dim LargestFaceArea As Double

          Dim CurrentFaceArea As Double

          Body = swPart.GetBodies2(swSolidBody, True)

          swModExt.SelectByID2 Body(0).Name, "SOLIDBODY", 0#, 0#, 0#, True, 0, Nothing, swSelectOptionDefault

          Set swBody = swSelMgr.GetSelectedObject6(1, -1)

           Set swFace = swBody.GetFirstFace

          Do While Not swFace Is Nothing

              CurrentFaceArea = swFace.GetArea

              If CurrentFaceArea > LargestFaceArea Then

                  LargestFaceArea = CurrentFaceArea

                  swFace.Select (0)

              End If

              Set swFace = swFace.GetNextFace

          Loop

       

          ' Apply Move/Copy feature

          Dim longstatus As Long

          Dim Component As Object

          Dim FeatureData As Object

          Dim varFeature As Object

          swPart.ClearSelection2 True

          swPart.Extension.SelectByID2 Body(0).Name, "SOLIDBODY", 0, 0, 0, False, 1, Nothing, 0

          Set varFeature = swPart.FeatureManager.InsertMoveCopyBody2(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, False, 1)

          Set FeatureData = varFeature.GetDefinition()

          swPart.Extension.SelectByID2 "", "FACE", 0, 0.05, 0.008, False, 1, Nothing, 0 ' <---- MUST BE GENERALISED!!!

          swPart.Extension.SelectByID2 "Front Plane", "PLANE", 0, 0, 0, True, 1, Nothing, 0

          FeatureData.AddMate Nothing, 0, 0, 0, 0, longstatus

          varFeature.ModifyDefinition FeatureData, swPart, Component

      End Sub

        • Re: Body-Move/Copy VBA Help needed (SelectByID2 with Face?)
          Artem Taturevych

          Are you trying to select the face with largest area which you are finding in the snippet before? If so you can just call the Select method just the same as you are doing here:

           

          swFace.Select (0)

           

          You just need to store the pointer to the face. Something like that:

           

          Dim maxFace as SldWorks.Face

           

          Do While Not swFace Is Nothing

                  CurrentFaceArea = swFace.GetArea

                  If CurrentFaceArea > LargestFaceArea Then

                      LargestFaceArea = CurrentFaceArea

                      swFace.Select (0)

                      Set maxFace = swFace

                  End If

                  Set swFace = swFace.GetNextFace

          Loop

          and then select instead of SelectByID2

          maxFace.Select2 False, 1

           

          Otherwise sorry - I have missed your point.

          __________________________

          Regards,

          Artem Taturevych

          Application Engineer at Intercad

          http://intercad.com.au/

          Tel: +61 2 9454 4444

            • Re: Body-Move/Copy VBA Help needed (SelectByID2 with Face?)
              Chris Day

              Hi Artem,

               

              Thanks for your time. That is what I'm looking to do, and your solution is surprisingly simple.

               

              However, it doesn't seem to work after I've initiated the Move/Copy feature. When the line maxFace.Select2 runs I get an error saying "The object invoked has disconnected from its clients." The line runs fine inside and immediately after the loop, so in itself it's working fine. Once maxFace has been set it reads <No Variables> all the way up to the error, and as far as I can see the Face interface doesn't even have a Select method (although I imagiine it inherits it from a parent?) so I'm not really sure how to debug this. Searching for a solution online also yielded no results.

               

              Below is the full code I'm using, in case I'm doing something weird. I tried it with both Face and Face2 interfaces with no change in result.

              Private Sub AfterCreation()

                  Dim swSelMgr As SldWorks.SelectionMgr

                  Dim swBody As SldWorks.Body2

                  Dim swFace As SldWorks.Face2

                  Dim swEntity As SldWorks.Entity

                  Dim swSelData As SldWorks.SelectData

                  Dim swModExt As SldWorks.ModelDocExtension

                  Dim Faces As Variant

                  Dim Body As Variant

                  Dim swPart As SldWorks.ModelDoc2

                  Dim swComponent As SldWorks.Component2

               

                  Dim swApp As SldWorks.SldWorks    

                  Dim swModel As SldWorks.ModelDoc2  

                  Set swApp = Application.SldWorks   

                  Set swModel = swApp.ActiveDoc     

               

                  ' Reorient to principal views

                  Set swPart = swModel

                  Set swModExt = swModel.Extension

                  Set swSelMgr = swModel.SelectionManager

                  swPart.ClearSelection2 True

                  Body = swPart.GetBodies2(swSolidBody, True)

                  swModExt.SelectByID2 Body(0).Name, "SOLIDBODY", 0#, 0#, 0#, True, 0, Nothing, swSelectOptionDefault

                  Set swBody = swSelMgr.GetSelectedObject6(1, -1)

               

                  ' Find face with largest surface area to align with front plane

                  Dim LargestFaceArea As Double

                  Dim CurrentFaceArea As Double

                  Dim maxFace As SldWorks.Face2

                  Set swFace = swBody.GetFirstFace

                  Do While Not swFace Is Nothing

                      CurrentFaceArea = swFace.GetArea

                      If CurrentFaceArea > LargestFaceArea Then

                          LargestFaceArea = CurrentFaceArea

                          swFace.Select (0)

                          Set maxFace = swFace

                          swPart.ClearSelection2 True

                          maxFace.Select2 False, 1      ' <-- runs fine

                      End If

                      Set swFace = swFace.GetNextFace

                  Loop

               

                  swPart.ClearSelection2 True

                  maxFace.Select2 False, 1     ' <-- runs fine

               

                  ' Apply Move/Copy feature

                  Dim longstatus As Long

                  Dim Component As Object

                  Dim FeatureData As Object

                  Dim varFeature As Object

                  swPart.ClearSelection2 True

                  swModExt.SelectByID2 Body(0).Name, "SOLIDBODY", 0, 0, 0, False, 1, Nothing, 0

                  Set varFeature = swPart.FeatureManager.InsertMoveCopyBody2(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, False, 1)

                  Set FeatureData = varFeature.GetDefinition()

                  maxFace.Select2 False, 1  ' <-- object has disconnected

                  swPart.Extension.SelectByID2 "Front Plane", "PLANE", 0, 0, 0, True, 1, Nothing, 0

                  FeatureData.AddMate Nothing, 0, 0, 0, 0, longstatus

                  varFeature.ModifyDefinition FeatureData, swPart, Component

              End Sub