5 Replies Latest reply on Apr 8, 2015 7:36 AM by Dave Paul

    VBA: Assembly Part Locator and Zoom (Issue)

    Dave Paul

      I am attempting to write a routine that will zoom into a part location, within an assembly.  Hopefully, the routine will locate the part, pull the bounding box, use that data to zoom to the part location.    The issue that I'm having is that the "CreatePoint" method doesn't seem to like what I'm handing it.  It may be the same issue that others are having, but I'd like to confirm it.  The code below is a test routine, but it should give me the results that I was needing.

      Thank you for any information,

      -Dave

       

      Sub main()

          Dim swApp                       As SldWorks.SldWorks

          Dim swModel                     As SldWorks.ModelDoc2

          Dim swPart                      As SldWorks.PartDoc

          Dim swSelMgr                    As SldWorks.SelectionMgr

          Dim swSelComp                   As SldWorks.Component2

          Dim swMathUtil                  As MathUtility

          Dim swSelPt1                    As SldWorks.MathPoint

          Dim swSelPt2                    As SldWorks.MathPoint

          Dim vSelPt1                     As Variant

          Dim vBody                       As Variant

          Dim vBox                        As Variant

          Dim Point1(2)                   As Double

          Dim Point2(2)                   As Double

          Dim spPnt1                      As ISketchPoint

          Dim spPnt2                      As ISketchPoint

          Dim i                           As Long

          Dim bRet                        As Boolean

          Dim comps As Variant

         

          Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

         

          Dim comp As Component2

          comps = swModel.GetComponents(False)

          For i = 0 To UBound(comps)

              Set comp = comps(i)

              If comp.Name2 = "Part23-1" Then

                Debug.Print "Name: " & comp.Name2

                Debug.Print "GetSelectByIDString: " & comp.GetSelectByIDString

                Set swSelMgr = swModel.SelectionManager

                swModel.Extension.SelectByID2 comp.GetSelectByIDString, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0

                Set swSelComp = swSelMgr.GetSelectedObjectsComponent(1)

                Debug.Print "Selected Name: " & swSelComp.Name2

               

                If swSelComp.Visible = swComponentVisible Then

                  vBox = swSelComp.GetBox(False, False)

                  Point2(0) = GetMax(vBox(0), vBox(3), Point1(0))

                  Point1(0) = GetMin(vBox(0), vBox(3), Point2(0))

                  Point2(1) = GetMax(vBox(1), vBox(4), Point1(1))

                  Point1(1) = GetMin(vBox(1), vBox(4), Point2(1))

                  Point2(2) = GetMax(vBox(2), vBox(5), Point1(2))

                  Point1(2) = GetMin(vBox(2), vBox(5), Point2(2))

                  Set swSelPt1 = swMathUtil.CreatePoint(Point1)

                  Set swSelPt2 = swMathUtil.CreatePoint(Point2)

                  Call ZoomToSelection(swSelPt1, swSelPt2)

                End If

               

              End If

          Next

      End Sub