15 Replies Latest reply on Jun 28, 2014 5:11 AM by Sushil Chaskar

    Getting all sketch points.

    Sushil Chaskar

      I am trying to get sketpoints of all the sketches on model doc.  For that I need to select all sketches first and then all sketch points on each sketch.. I am able to get sketch point for one sketch but can not for all sketches. I dont know the general method that will select all sketches. I have tried to some extent. plz help out .. Posting my code..

      I am facing problems in the bolded lines as i am not aware how to define them..

       

       

       

      Option Explicit

      Sub main()

      Dim swApp As SldWorks.SldWorks

      Dim Part As SldWorks.PartDoc

      Dim theSketch As SldWorks.Sketch

      Dim sketchPointArray As Variant

      Dim sketchArray As Variant

      Dim i As Long

      Dim swSel As SldWorks.SelectionMgr

      Dim pointCount As Long

      Dim xValue As Double

      Dim yValue As Double

      Dim zValue As Double

      Dim swModelext As SldWorks.ModelDocExtension

      Dim swSketchMgr As SldWorks.SketchManager

      Dim bValue As Boolean

      Dim v As Variant

      Dim Sketch As Variant

      ' Set swApp = CreateObject("SldWorks.Application")

      Set swApp = Application.SldWorks

       

       

      Set Part = swApp.ActiveDoc

      Set swModelext = Part.Extension

      Set swSel = Part.SelectionManager

       

       

      ' swModelext.SelectAll

       

       

      Set swSketchMgr = Part.SketchManager

       

       

       

       

      ' Part.ClearSelection2 True

      'Set theSketch = Part.GetActiveSketch2

      ' v = Part.GetBodies

      ' If theSketch Is Nothing Then

       

       

       

      Dim j As Integer

      For j = o to UBound() 

       

       

      bValue = Part.Extension.SelectByID2(Sketch(j), "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

      swSketchMgr.InsertSketch False

      Set theSketch = Part.GetActiveSketch2

      ' sketchArray() = theSketch

          ' Activate the sketch

      sketchPointArray = theSketch.GetSketchPoints2

      pointCount = UBound(sketchPointArray) + 1

      ' For each SketchPoint

      For i = 0 To (pointCount - 1)

          ' Get the coordinates

          xValue = sketchPointArray(i).X

          yValue = sketchPointArray(i).Y

          zValue = sketchPointArray(i).Z

          Debug.Print "Sketch point x ,y and z coordinates: " & xValue; yValue; "and " & zValue

          Debug.Print " "

          ' Do something useful with the data

      Next i

      Next j

      ' End If

      End Sub

        • Re: Getting all sketch points.
          Manikandan Babu

          HI,

           

                          Please go through it.

           

          Option Explicit

          Sub main()

          Dim swApp As SldWorks.SldWorks

          Dim Part As SldWorks.PartDoc

          Dim swSketch As SldWorks.Sketch

          Dim swfeature As SldWorks.Feature

          Dim sketchPointArray As Variant

          Dim sketchArray As Variant

          Dim i As Long

          Dim swSel As SldWorks.SelectionMgr

          Dim pointCount As Long

          Dim xValue As Double

          Dim yValue As Double

          Dim zValue As Double

          Dim swModelext As SldWorks.ModelDocExtension

          Dim swSketchMgr As SldWorks.SketchManager

          Dim bValue As Boolean

          Dim v As Variant

          Dim Sketch As Variant

           

           

          Set swApp = Application.SldWorks

          Set Part = swApp.ActiveDoc

          Set swfeature = Part.FirstFeature

          While Not swfeature Is Nothing

          If swfeature.GetTypeName = "ProfileFeature" Then

          swfeature.Select2 True, 0

          Set swSketch = swfeature.GetSpecificFeature

          sketchPointArray = swSketch.GetSketchPoints2

          pointCount = UBound(sketchPointArray) + 1

          For i = 0 To (pointCount - 1)

          xValue = sketchPointArray(i).X

          yValue = sketchPointArray(i).Y

          zValue = sketchPointArray(i).Z

          swApp.SendMsgToUser "Sketch point x ,y and z coordinates: " & xValue & yValue & "and " & zValue

          Next i

          End If

          Set swfeature = swfeature.GetNextFeature

          Wend

           

          End Sub

           

           

           

           

           

          Manikandan B

          EGS Computers India Pvt Ltd

          http://www.egsindia.com

          http://www.egs.co.in

            • Re: Getting all sketch points.
              Sushil Chaskar

              Thank you so much..  Is there any way by whiich we can store the sketch points in a file ?

                • Re: Getting all sketch points.
                  Patrick O'Hern

                  Here is a sub that I use to output data into a CSV file.

                       strFile = The full path name of the file you want to output to (ie. C:\Coords.csv)

                       strListArr = The array of data you wish to output (must be in String format)

                   

                  Sub OutputData(strFile As String, strListArr() As String)

                      Dim intFile As Integer

                      Dim i As Long

                     

                  'Get next available file number

                      intFile = FreeFile

                     

                  'Open file for data output

                      Open strFile For Output As #intFile

                  'Step through file list array

                      For i = LBound(strListArr) To UBound(strListArr)

                      'Output data to file

                          Print #intFile, strListArr(i)

                      Next i

                     

                  'Close file after data output

                      Close #intFile

                  End Sub

                   

                   

                  In order to use it, you'll need to convert your coords to a string array:

                      

                      Dim strCoordsArray(pointCount -1) as String

                      For i = 0 to pointCount -1
                          strCoordsArray(i) = sketchPointArray(i).X & "," & sketchPointArray(i).Y & "," & sketchPointArray(i).Z
                      Next i

                   

                    • Re: Getting all sketch points.
                      Sushil Chaskar

                      I dis this way.. Getting  error stating Object Required in bolided line.

                       

                       

                      Option Explicit

                       

                       

                      Sub main()

                      Dim swApp As SldWorks.SldWorks

                      Dim Part As SldWorks.PartDoc

                      Dim swSketch As SldWorks.Sketch

                      Dim swfeature As SldWorks.Feature

                      Dim sketchPointArray As Variant

                      Dim sketchArray As Variant

                      Dim i As Long

                      Dim swSel As SldWorks.SelectionMgr

                      Dim pointCount As Long

                      Dim xValue As Double

                      Dim yValue As Double

                      Dim zValue As Double

                      Dim swModelext As SldWorks.ModelDocExtension

                      Dim swSketchMgr As SldWorks.SketchManager

                      Dim bValue As Boolean

                      Dim v As Variant

                      Dim Sketch As Variant

                      Dim strCoordsArray() As String

                       

                      Set swApp = Application.SldWorks

                      Set Part = swApp.ActiveDoc

                      Set swfeature = Part.FirstFeature

                      While Not swfeature Is Nothing

                      If swfeature.GetTypeName = "ProfileFeature" Then

                      swfeature.Select2 True, 0

                      Set swSketch = swfeature.GetSpecificFeature

                      sketchPointArray = swSketch.GetSketchPoints2

                      pointCount = UBound(sketchPointArray) + 1

                      For i = 0 To (pointCount - 1)

                      xValue = sketchPointArray(i).X

                      yValue = sketchPointArray(i).Y

                      zValue = sketchPointArray(i).Z

                      strCoordsArray(i) = sketchPointArray(i).X & "," & sketchPointArray(i).Y & "," & sketchPointArray(i).Z

                             

                         

                          Next i

                      End If

                      Set swfeature = swfeature.GetNextFeature

                      Wend

                       

                        

                         

                      Dim strFile As String

                      Dim strListArr() As String

                      Dim intFile As Integer

                      Dim k As Long

                        

                      Set strFile = "C:\MyDocuments\main.csv"

                        Set strListArr = strCoordsArray

                      'Get next available file number

                          intFile = FreeFile

                        

                      'Open file for data output

                          Open strFile For Output As #intFile

                      'Step through file list array

                          For k = LBound(strListArr) To UBound(strListArr)

                          'Output data to file

                              Print #intFile, strListArr(k)

                          Next k

                        

                       

                       

                          Close #intFile

                       

                       

                         

                      End Sub

                        • Re: Getting all sketch points.
                          Patrick O'Hern

                          Try this:

                           

                           

                          Option Explicit

                           

                           

                          Sub main()

                          Dim swApp As SldWorks.SldWorks

                          Dim Part As SldWorks.PartDoc

                          Dim swSketch As SldWorks.Sketch

                          Dim swfeature As SldWorks.Feature

                          Dim sketchPointArray As Variant

                          Dim sketchArray As Variant

                          Dim i As Long

                          Dim swSel As SldWorks.SelectionMgr

                          Dim pointCount As Long

                          Dim xValue As Double

                          Dim yValue As Double

                          Dim zValue As Double

                          Dim swModelext As SldWorks.ModelDocExtension

                          Dim swSketchMgr As SldWorks.SketchManager

                          Dim bValue As Boolean

                          Dim v As Variant

                          Dim Sketch As Variant

                          Dim strCoordsArray() As String

                           

                          Set swApp = Application.SldWorks

                          Set Part = swApp.ActiveDoc

                          Set swfeature = Part.FirstFeature

                          While Not swfeature Is Nothing

                          If swfeature.GetTypeName = "ProfileFeature" Then

                          swfeature.Select2 True, 0

                          Set swSketch = swfeature.GetSpecificFeature

                          sketchPointArray = swSketch.GetSketchPoints2

                          pointCount = UBound(sketchPointArray) + 1

                          Redim strCoordsArray(pointCount-1) as String

                          For i = 0 To (pointCount - 1)

                          xValue = sketchPointArray(i).X

                          yValue = sketchPointArray(i).Y

                          zValue = sketchPointArray(i).Z

                          strCoordsArray(i) = sketchPointArray(i).X & "," & sketchPointArray(i).Y & "," & sketchPointArray(i).Z

                           

                              Next i

                          End If

                          Set swfeature = swfeature.GetNextFeature

                          Wend

                           

                          Dim strFile As String

                          Dim intFile As Integer

                          Dim k As Long

                           

                              strFile = "C:\MyDocuments\main.csv"

                          'Get next available file number

                              intFile = FreeFile

                           

                          'Open file for data output

                              Open strFile For Output As #intFile

                          'Step through file list array

                              For k = LBound(strCoordsArray) To UBound(strCoordsArray)

                              'Output data to file

                                  Print #intFile, strCoordsArray(k)

                              Next k

                           

                              Close #intFile

                          End Sub

                            • Re: Getting all sketch points.
                              Sushil Chaskar

                              Can you suggest how can we encode below code into vb.net . Actually using VS2010.

                               

                              Open file for data output

                                  Open strFile For Output As #intFile

                              'Step through file list array

                                  For k = LBound(strCoordsArray) To UBound(strCoordsArray)

                                  'Output data to file

                                      Print #intFile, strCoordsArray(k)

                                  Next k

                               

                                  Close #intFile

                              End Sub

                              • Re: Getting all sketch points.
                                Sushil Chaskar

                                thank you. By the code, i am able to write only sketchpoints of a sketch and not all sketches.. Any thought..

                                  • Re: Getting all sketch points.
                                    Patrick O'Hern

                                    This should get the coordinates of points in all sketches:

                                     

                                     

                                    Option Explicit

                                     

                                    Sub main()

                                        Dim swApp As SldWorks.SldWorks

                                        Dim Part As SldWorks.PartDoc

                                        Dim swSketch As SldWorks.Sketch

                                        Dim swfeature As SldWorks.Feature

                                        Dim sketchPointArray As Variant

                                        Dim sketchArray As Variant

                                        Dim i As Long

                                        Dim swSel As SldWorks.SelectionMgr

                                        Dim pointCount As Long

                                        Dim xValue As Double

                                        Dim yValue As Double

                                        Dim zValue As Double

                                        Dim swModelext As SldWorks.ModelDocExtension

                                        Dim swSketchMgr As SldWorks.SketchManager

                                        Dim bValue As Boolean

                                        Dim v As Variant

                                        Dim Sketch As Variant

                                        Dim strCoordsArray() As String

                                        Dim pointTotal As Long

                                     

                                        Set swApp = Application.SldWorks

                                        Set Part = swApp.ActiveDoc

                                        Set swfeature = Part.FirstFeature

                                        While Not swfeature Is Nothing

                                            If swfeature.GetTypeName = "ProfileFeature" Then

                                                swfeature.Select2 True, 0

                                                Set swSketch = swfeature.GetSpecificFeature

                                                sketchPointArray = swSketch.GetSketchPoints2

                                                pointCount = UBound(sketchPointArray) + 1

                                                pointTotal = pointTotal + pointCount

                                                ReDim Preserve strCoordsArray(pointTotal - 1) As String

                                                For i = 0 To (pointCount - 1)

                                                    xValue = sketchPointArray(i).X

                                                    yValue = sketchPointArray(i).Y

                                                    zValue = sketchPointArray(i).Z

                                                    strCoordsArray(pointTotal - pointCount + i) = xValue & "," & yValue & "," & zValue

                                                Next i

                                            End If

                                            Set swfeature = swfeature.GetNextFeature

                                        Wend

                                        

                                        Dim strFile As String

                                        Dim intFile As Integer

                                        Dim k As Long

                                     

                                        strFile = "C:\MyDocuments\main.csv"

                                    'Get next available file number

                                        intFile = FreeFile

                                     

                                    'Open file for data output

                                        Open strFile For Output As #intFile

                                    'Step through file list array

                                        For k = LBound(strCoordsArray) To UBound(strCoordsArray)

                                        'Output data to file

                                            Print #intFile, strCoordsArray(k)

                                        Next k

                                     

                                        Close #intFile

                                    End Sub

                                     

                                  • Re: Getting all sketch points.
                                    Sushil Chaskar

                                    I am working on an algo that will detect the best possible parting line for any kind of model.. Can you help me in the algo as how should i proceed?

                          • Re: Getting all sketch points.
                            Sushil Chaskar

                            trying to get midpoints of the point having same x and y coordinates.. getting error of invalid qualifier in bold line. any help?

                             

                            Option Explicit

                             

                            Sub main()

                                Dim swApp As SldWorks.SldWorks

                                Dim Part As SldWorks.PartDoc

                                Dim swSketch As SldWorks.Sketch

                                Dim swfeature As SldWorks.Feature

                                Dim sketchPointArray As Variant

                                Dim sketchArray As Variant

                                Dim i As Long

                                Dim k As Long

                                Dim l As Long

                                Dim swSel As SldWorks.SelectionMgr

                                Dim pointCount As Long

                                Dim xValue As Double

                                Dim yValue As Double

                                Dim zValue As Double

                                Dim x As Double

                                Dim y As Double

                                Dim z As Double

                                Dim swModelext As SldWorks.ModelDocExtension

                                Dim swSketchMgr As SldWorks.SketchManager

                                Dim bValue As Boolean

                                Dim v As Variant

                                Dim Sketch As Variant

                                Dim strCoordsArray() As String

                                Dim midpointsArray() As String

                                Dim pointTotal As Long

                             

                                Set swApp = Application.SldWorks

                                Set Part = swApp.ActiveDoc

                                Set swfeature = Part.FirstFeature

                                While Not swfeature Is Nothing

                                    If swfeature.GetTypeName = "3DProfileFeature" Then

                                        swfeature.Select2 True, 0

                                        Set swSketch = swfeature.GetSpecificFeature

                                        sketchPointArray = swSketch.GetSketchPoints2

                                        pointCount = UBound(sketchPointArray) + 1

                                        pointTotal = pointTotal + pointCount

                                        ReDim Preserve strCoordsArray(pointTotal - 1) As String

                                        For i = 0 To (pointCount - 1)

                                            xValue = sketchPointArray(i).x

                                            yValue = sketchPointArray(i).y

                                            zValue = sketchPointArray(i).z

                                            strCoordsArray(pointTotal - pointCount + i) = xValue & "," & yValue & "," & zValue

                                        Next i

                                    End If

                                    Set swfeature = swfeature.GetNextFeature

                                Wend

                                 MsgBox (LBound(strCoordsArray) + 1)

                                MsgBox (UBound(strCoordsArray) + 1)

                              

                                For k = LBound(strCoordsArray) To UBound(strCoordsArray)

                                For l = k + 1 To UBound(strCoordsArray)

                                If strCoordsArray(k).x = strCoordsArray(l).x And strCoordsArray(k).y = strCoordsArray(l).y Then

                                x = strCoordsArray(k).x

                                y = strCoordsArray(k).y

                                z = (strCoordsArray(k).z + strCoordsArray(l).z) / 2

                              

                               swApp.SendMsgToUser "Sketch point x ,y and z coordinates: " & x & y & "and " & z

                               

                                End If

                                Next l

                                Next k

                            End Sub