2 Replies Latest reply on Jun 4, 2014 8:10 AM by Andreas Killer

    Getting XYZ coordinates from a surface.

    Robert Geshlider



      I posted this in "General" last week but got no replies, so I'm reposting here hoping that someone has a solution.


      Is there an easy way to generate XYZ coordinates from surfaces?  In my situation, the X and Y coordinates will always lie on a fixed, known grid, but the Z height varies across the surface.


      In the attached example, the surface is named "Surface-Knit1", and the X and Y coordinates are the centers of each of the small circles in Sketch7 (bottom of the feature tree).


      I've got many surfaces like "Surface-Knit1" but the grid like Sketch7 will always be the same.


      Ideally, I'd like the origin to be based on Coordinate System1 (also at the bottom of the feature tree).



        • Re: Getting XYZ coordinates from a surface.
          Artem Taturevych

          Hello Robert,


          Yes, it is definitely possible to do with a custom macro/program. Macro can either grab existing points from block or sketch like in your case as well as split the surface with specified step. The result can be exported to Excel or XML or whatever else. If you have a programming skill I'm happy to share the techniques to do this otherwise I would suggest the professional service which you can request from IC3D Development Team here dev@ic3d.com.au. We will provide a quote based on your request.


          Regards, Artem Taturevych | Snr. Developer | IC3D ANZ


          IC3DSteel – New Steel Solution for SolidWorks

          translationXpert – SolidWorks files language translator

          LinkedIn - SolidWorks API Group

            • Re: Getting XYZ coordinates from a surface.
              Andreas Killer

              Hi Artem,


              I'm also interested to see your solution. Especially I think it is simpler as my one.


              EDIT: You have modifiy the "Test surface.SLDPRT" before the code below works: Edit Sketch7 and explode the block, so the points are all inside the sketch directly.




              Option Explicit


              Sub PointsOnSurface()
                'Pre conditions:
                '  A sketch with points is selected
                '  At min. one surface is selected
                'Post conditions:
                '  Hit points are shown in the immediate window
                Dim swApp As SldWorks.SldWorks
                Dim mathUtils As SldWorks.MathUtility
                Dim swModel As SldWorks.ModelDoc2
                Dim swSelMgr As SldWorks.SelectionMgr
                Dim i As Long, j As Long, k As Long
                Dim swSketch As SldWorks.Sketch
                Dim swFeat As SldWorks.Feature
                Dim swFaces As New Collection
                Dim swFace As SldWorks.Face2
                Dim swSurface As SldWorks.Surface
                Dim Temp
                Set swApp = Application.SldWorks
                Set mathUtils = swApp.GetMathUtility()
                Set swModel = swApp.ActiveDoc
                Set swSelMgr = swModel.SelectionManager
                'Check the selected objects
                For i = 1 To swSelMgr.GetSelectedObjectCount2(0)
                  Select Case swSelMgr.GetSelectedObjectType3(i, 0)
                    Case swSelectType_e.swSelSKETCHES
                      'Get the sketch
                      Set swFeat = swSelMgr.GetSelectedObject6(i, 0)
                      Set swSketch = swFeat.GetSpecificFeature2
                    Case swSelectType_e.swSelBODYFEATURES, swSelectType_e.swSelREFSURFACES
                      'Get the faces from surfaces from the selection manager
                      Set swFeat = swSelMgr.GetSelectedObject6(i, 0)
                      Temp = swFeat.GetFaces
                      For j = 0 To UBound(Temp)
                        Set swFace = Temp(j)
                        swFaces.Add swFace
                    Case swSelectType_e.swSelFACES
                      'Get the faces from surfaces from the model
                      Set swFace = swSelMgr.GetSelectedObject6(i, 0)
                      swFaces.Add swFace
                  End Select
                'Be sure we have what we need
                If swSketch Is Nothing Then
                  MsgBox "No sketch is selected"
                  Exit Sub
                End If
                If swSketch.GetSketchPointsCount2 = 0 Then
                  MsgBox "Sketch has no points"
                  Exit Sub
                End If
                If swFaces.Count = 0 Then
                  MsgBox "Select at min. one face"
                  Exit Sub
                End If
                Dim Point() As Double
                Dim rayVectorUp As SldWorks.MathVector, rayVectorDn As SldWorks.MathVector
                'Create the ray vector from the sketch
                Dim swXform As SldWorks.MathTransform
                Set swXform = swSketch.ModelToSketchTransform
                With swXform
                  Point = ArrayD(.ArrayData(6), .ArrayData(7), .ArrayData(8))
                End With
                Set rayVectorUp = mathUtils.CreateVector(Point)
                'Create a ray vector in the opposide direction
                For i = LBound(Point) To UBound(Point)
                  Point(i) = Point(i) * -1
                Set rayVectorDn = mathUtils.CreateVector(Point)
                Dim swSketchPoints, swSketchPoint
                Dim swPoint As SldWorks.SketchPoint
                Dim rayPoint As SldWorks.MathPoint
                Dim intersectPt As SldWorks.MathPoint
                swSketchPoints = swSketch.GetSketchPoints2
                i = 0
                j = 0
                k = 0
                For Each swSketchPoint In swSketchPoints
                  i = i + 1
                  Set swPoint = swSketchPoint
                  Point = SketchPoint2ModelPoint(mathUtils, swPoint)
                  Set rayPoint = mathUtils.CreatePoint(Point)
                  For Each swFace In swFaces
                    Set intersectPt = swFace.GetProjectedPointOn(rayPoint, rayVectorUp)
                    If intersectPt Is Nothing Then
                      Set intersectPt = swFace.GetProjectedPointOn(rayPoint, rayVectorDn)
                    End If
                    If Not intersectPt Is Nothing Then
                      j = j + 1
                      Debug.Print "Nr " & j, "Pt " & i, ArrayDataStr(intersectPt.ArrayData)
                      Exit For
                    End If
                  If swFace Is Nothing Then
                    'no hit
                    k = k + 1
                  End If
                If k > 0 Then Debug.Print k & " points doesn't hit"
              End Sub


              Private Function SketchPoint2ModelPoint(swMathUtil As SldWorks.MathUtility, _
                  swSkPt As SldWorks.SketchPoint) As Variant
                'Transform sketch point coordinates to model coordinates
                Dim vPt As Variant
                Dim swXform As SldWorks.MathTransform
                Dim swMathPt As SldWorks.MathPoint
                With swSkPt
                  vPt = ArrayD(.X, .Y, .Z)
                End With
                If Not swSkPt.GetSketch.Is3D Then
                  Set swMathPt = swMathUtil.CreatePoint(vPt)
                  Set swXform = swSkPt.GetSketch.ModelToSketchTransform
                  Set swXform = swXform.Inverse
                  Set swMathPt = swMathPt.MultiplyTransform(swXform)
                  vPt = swMathPt.ArrayData
                End If
                SketchPoint2ModelPoint = vPt
              End Function


              Private Function ArrayD(ParamArray Args()) As Variant
                'Return array of Double
                Dim Result() As Double, i As Long
                ReDim Result(0 To UBound(Args))
                For i = 0 To UBound(Args)
                  Result(i) = Args(i)
                ArrayD = Result
              End Function


              Private Function ArrayDataStr(ByVal ArrayData) As String
                Dim i As Integer
                Dim Mask
                Mask = "X@0 Y@1 Z@2"
                For i = LBound(ArrayData) To UBound(ArrayData)
                  Mask = Replace(Mask, "@" & i, Format(ArrayData(i), "0.000"))
                ArrayDataStr = Mask
              End Function