AnsweredAssumed Answered

Get Sketch Points

Question asked by Steve Anderson on Jan 9, 2014
Latest reply on Jan 9, 2014 by Matt Martens

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.

Outcomes