1 Reply Latest reply on Jan 9, 2014 3:12 PM by Matt Martens

    Get Sketch Points

    Steve Anderson

      I have an assembly with a back panel and several lighting components.  Ultimately, I am looking to get the sketch points from each lighting component and transfer them to the back panel, producing an end result of where the connection holes will exist in the back panel.

       

      I am trying very hard, much too hard in fact!!, to pan through the objects and obtain the sketch points.  My only goal in the code below is to see if I can obtain the coordinate locations.  I velieve the symtax is correct, except for the option to get the sketch points.

       

                      ' Get Sketch Points

                      Dim vSketchPoints As Variant

                      vSketchPoints = swSketch.GetSketchPoints2  - ERRORS HERE WITH Run-time error '91'; Object variable or With block not set. 

                      Dim vSketchPoint As Variant

                      Dim swSketchPoints As SldWorks.SketchPoint

                      Dim swSketchPoint As SldWorks.SketchPoint

       

      The complete code is listed below:

       

      Sub main()

       

       

          ' Connect to SolidWorks

          Dim swApp As SldWorks.SldWorks

          Set swApp = Application.SldWorks

         

          ' Model - Not used yet

          Dim swModel As SldWorks.ModelDoc2

          Set swModel = swApp.GetFirstDocument

         

          ' Assembly, Current active document if it is an assembly

          Dim swAssy As SldWorks.AssemblyDoc

          Set swAssy = swApp.ActiveDoc

                 

          ' Get Components in assembly

          Dim swCompArr As Variant

          Dim swComp As SldWorks.Component2

         

          Do While Not swModel Is Nothing

              If Not swModel.GetType = swDocumentTypes_e.swDocPART Then

                  ' Do Nothing

         

              Else

                  swCompArr = swAssy.GetComponents(True)

                 

              End If

                 

              For i = 1 To UBound(swCompArr)

                  Set swComp = swCompArr(i)

                                             

                  ' Component Part No must begin with 242 and not be supressed

                  If swComp.IsSuppressed = 1 Or Left(swComp.Name, 3) <> "242" Then

                      ' Do Nothing

                                                                              

                  Else

                      ' Set Component

                      Dim swModel2 As SldWorks.ModelDoc2

                      Set swModel2 = swComp.GetModelDoc2

       

       

                      Dim swModelDocExt As SldWorks.ModelDocExtension

                      Set swModelDocExt = swModel2.Extension

                         

                      Dim swSelMgr As SldWorks.SelectionMgr

                      Set swSelMgr = swModel2.SelectionManager

                         

                      Dim bComp As Boolean

                      bComp = swModelDocExt.SelectByID2("#20 (0.161) Diameter Hole1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, swSelectOptionDefault)

                     

                      Dim Feature As SldWorks.Feature

                      Set Feature = swSelMgr.GetSelectedObject5(1)

                         

                      swModel2.ClearSelection2 True

                       

                      Dim FeatureData As SldWorks.WizardHoleFeatureData2

                      Set FeatureData = Feature.GetDefinition

                         

                      Dim nCount As Long

                      nCount = FeatureData.GetSketchPointCount

                      MsgBox ("Component: " & swComp.Name & " Sketch Point Count = " & nCount)

                    

                      Dim swSketchMgr As SldWorks.SketchManager

                      Set swSketchMgr = swModel2.SketchManager

                                     

                      Dim bSketch As Boolean

                      bSketch = swModel2.Extension.SelectByID2("#20_MASTER_Sketch", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

                                  

                      swModel2.ClearSelection2 True

                     

                      Dim swSketch As SldWorks.Sketch

                      Set swSketch = swModel2.GetActiveSketch2

                 

                      ' Get Sketch Points

                      Dim vSketchPoints As Variant

                      vSketchPoints = swSketch.GetSketchPoints2

                      Dim vSketchPoint As Variant

                      Dim swSketchPoints As SldWorks.SketchPoint

                      Dim swSketchPoint As SldWorks.SketchPoint

       

       

                      swSketchMgr.InsertSketch False

                                                  

                      If (Not IsEmpty(vSketchPoints)) Then

                          For Each vSketchPoint In vSketchPoints

                              Set swSketchPoint = vSketchPoint

                              Dim dPoint(2) As Double

                              dPoint(0) = swSketchPoint.X

                              dPoint(1) = swSketchPoint.Y

                              dPoint(2) = swSketchPoint.Z

                             

                              swSketchPoint.Select4 False, Nothing

                             

                              MsgBox dPoint(0) & "; " & dPoint(1) & "; " & dPoint(2)

                                             

                          Next

                         

                      End If

                      ' Project points

       

       

                  End If

             

              Next

              Set swModel = swModel.GetNext

       

       

          Loop

         

      End Sub

       

      Any help with this is greatly apprectated.

        • Re: Get Sketch Points
          Matt Martens

          From the remarks section of the GetActiveSketch2 section of the API help:  Before you can use this method, you must select and activate a sketch. You can use IModelDocExtension::SelectByID2 to select a sketch and ISketchManager::InsertSketch to make the sketch active.

           

                          Dim bSketch As Boolean

                          bSketch = swModel2.Extension.SelectByID2("#20_MASTER_Sketch", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

                          swModel2.InsertSketch           

                          swModel2.ClearSelection2 True

                         

                          Dim swSketch As SldWorks.Sketch

                          Set swSketch = swModel2.GetActiveSketch2

                     

                          ' Get Sketch Points

                          Dim vSketchPoints As Variant

                          vSketchPoints = swSketch.GetSketchPoints2

                          Dim vSketchPoint As Variant

                          Dim swSketchPoints As SldWorks.SketchPoint

                          Dim swSketchPoint As SldWorks.SketchPoint

           

          You selected the sketch in the feature tree but you never activated it. So when you used GetActiveSketch2, your swSketch was coming back empty which in turn caused your error the next time you tried to use the swSketch object.