24 Replies Latest reply on Jun 30, 2016 11:24 AM by Thomas Bryant

    Automate creation of a sketch plane on an endpoint of a spring?

    Thomas Bryant

      I am automating a spring from multiple text files. After getting spring centerline data and wire diameter from a text file.  Each row represents a point, and each column represents the X, Y, and Z coordinate of those points, respectively.

       

      The spring has three features. First, the Curve feature takes the text file and makes a curve based on the points given.  Second, the Plane feature is used to put a sketch normal to the spring centerline. This sketch is a circle, whose diameter will be the wire diameter.  Third, the Sweep feature uses the sketch as a profile and the curve as a path to make the spring.

       

      The purpose of creating a sketch plane is to make the orientation at a right angle with respect to the end of the wire. I would like to position the spring's plane with respect to the right angle at the end of the wire and center the circle on the sketch. Presently, the circle shows up but the plane does not, regardless if I use InsertRefPlane or 3D Sketch Plane.

       

      I've also tried using this line:

       

      1. myModelView.RotateAboutCenter 0, (Y / 500)

       

      But it makes the plane disappear.

       

      I use it in conjunction with this line, where X, Y, and Z represent the spline text file data:

       

      Status = swSketchManager.CreateSketchPlane(X / 1000, Y / 1000, Z / 1000)

       

      Should I use RotateAboutCenter, or are angle, sin, cos functions, etc. needed here? Here is the code I have so far.

       

      Dim swApp As Object

      'Dim swApp As SldWorks.SldWorks

      Dim Part As Object

      'Dim Part As SldWorks.ModelDoc2

      Dim boolstatus As Boolean

      Dim longstatus As Long, longwarnings As Long

      Dim swModelDocExt As SldWorks.ModelDocExtension

      Dim swSketchManager As SldWorks.SketchManager

       

      'Initiate the Sub Routine

      Sub main()

      'On Error Resume Next

      Set swApp = _

      1. Application.SldWorks

       

      Set Part = swApp.ActiveDoc

      'swApp.ActiveDoc.ActiveView.FrameState = 1

       

      Dim skPoint As Object

      Dim File1 As String

      Dim FolderPath As String

      Dim files1 As Integer

      Dim path As String

      Dim swModel As SldWorks.ModelDoc2

      Dim swModelDocExt As SldWorks.ModelDocExtension

      Set swModel = swApp.ActiveDoc

      Dim myModelView As Object

      Set myModelView = Part.ActiveView

      Dim value As SketchSegment

      Dim instance As ISketchManager

      Dim radius As Double

      Dim swFeature As SldWorks.Feature

      Dim swFeatureManager As SldWorks.FeatureManager

      Dim curveNum As String

      Dim lineNum As String

      Dim sketchNum, sketchNum2, sketchNum3 As String

      Dim angle As Double

       

      Set xlapp = CreateObject("Excel.Application")

      FileName = xlapp.GetOpenFileName("Text Files (*.txt),*.txt*", , "Choose Spring Centerline Files...", , True)

      Set xlapp = Nothing

      If IsArray(FileName) = False Then

          MsgBox "Please select a file."

          Exit Sub

      End If

       

      'MsgBox "Number of files in directory: " & files1

       

      'Opens all the found Deform Files

      For j = 1 To UBound(FileName)

       

      Open FileName(j) For Input As #1

       

      ' Skips 5 Header lines, but there's probably a better way to do it

      For i = 1 To 5

          Input #1, X

      Next i 'End i For

       

      ' Makes your initial point

      Input #1, X, Y, Z, D

       

      'Loop that makes the spline centerline

      1. Part.InsertCurveFileBegin

      boolstatus = Part.InsertCurveFilePoint(X / 1000, Y / 1000, Z / 1000)

       

      Do While Not EOF(1)

      Input #1, X, Y, Z, D

      boolstatus = Part.InsertCurveFilePoint(X / 1000, Y / 1000, Z / 1000)

      Loop

      Close #1

      'Close Spline

       

      radius = D / 2000

       

      'Choose the right number Curve

      curveNum = "Curve" + CStr(j)

       

      'Choose the right number Sketch

      sketchNum = "Point" + CStr(j) + "@3DSketch" + CStr(j)

       

      'Selects the spline you just made

      boolstatus = Part.Extension.SelectByID2(curveNum, "REFERENCECURVES", X / 1000, Y / 1000, Z / 1000, True, 0, Nothing, 0)

      'Find some way to select the point that is made line 33

      boolstatus = Part.Extension.SelectByID2(sketchNum, "EXTSKETCHPOINT", X / 1000, Y / 1000, Z / 1000, True, 0, Nothing, 0)

        Set swSketchManager = swModel.SketchManager

      swSketchManager.Insert3DSketch True

          Set swSketchSegment = swSketchManager.CreateCenterLine(0, 0, 0#, 0, 0, 0#)

          Set swSketch = swSketchManager.ActiveSketch

          Status = swSketch.SetWorkingPlaneOrientation(0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0)

          Set swSketchSegment = swSketchManager.CreateCenterLine(0, 0, 0#, 0, 0, 0)

          Set swSketch = swSketchManager.ActiveSketch

          Status = swSketch.SetWorkingPlaneOrientation(0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0)

        

      'You now have 2 things selected. This should make a plane at the point normal to the curve

      Dim myRefPlane As SldWorks.RefPlane

      1. Part.ClearSelection2 True

       

          'Insert 2D sketch of a circle

      swModel.ActivateSelectedFeature

      swModel.ClearSelection2 True

      swSketchManager.InsertSketch True

          Set swModelDocExt = swModel.Extension

          Status = swModelDocExt.SelectByID2("Front Plane", "PLANE", X / 1000, Y / 1000, Z / 1000, True, 0, Nothing, 0)

      swModel.ClearSelection2 True

          Set swSketchSegment = swSketchManager.CreateCircleByRadius(X / 1000, Y / 1000, Z / 1000, radius)

      swModel.ClearSelection2 True

      swSketchManager.InsertSketch True

      swModel.ClearSelection2 True

      boolstatus = Part.InsertCurveFileEnd()

      'Choose the right number Curve

      lineNum = "Line" + CStr(j)

       

      'Choose the right number Sketch

      sketchNum2 = "Point" + CStr(j) + "@Sketch" + CStr(j)

       

      'Choose the right number Sketch

      sketchNum3 = "Plane" + CStr(j)

       

          'Insert a 3D sketch plane

      swSketchManager.Insert3DSketch True

          Status = swModelDocExt.SelectByID2("Line1@3DSketch1", "EXTSKETCHSEGMENT", X / 1000, Y / 1000, Z / 1000, True, 0, Nothing, 0)

          Status = swModelDocExt.SelectByID2("Point2@Sketch1", "EXTSKETCHPOINT", X / 1000, Y / 1000, Z / 1000, True, 0, Nothing, 0)

          Status = swSketchManager.CreateSketchPlane(X / 1000, Y / 1000, Z / 1000)

      myModelView.RotateAboutCenter 0, (Y / 500)

          Status = swModelDocExt.SelectByID2("Plane1", "SKETCHSURFACES", X / 1000, Y / 1000, Z / 1000, True, 0, Nothing, 0)

          'Set swXform = swMathUtil.CreateTransformRotateAxis(swOriginPt, swX_Axis, 1# * RadPerDeg)

      swModel.ActivateSelectedFeature

      swModel.ClearSelection2 True

      swSketchManager.InsertSketch True

       

      Next j 'End j For

       

      End Sub

       

      Note: I’ve tried using the InsertRefPlane function and can’t get that to show up at all when generating a spline from the data, despite the fact that that’s what appears when recording a macro that creates the spline.

       

      The spring should look like this:

       

      Spring example screenshot.PNG

        • Re: Automate creation of a sketch plane on an endpoint of a spring?
          Andreas Killer

          Thomas,

          Can you please upload a sample text file for testing?

          Andreas.

            • Re: Automate creation of a sketch plane on an endpoint of a spring?
              Thomas Bryant

              Hello Andreas,

               

              I have attached two sample text files and the macro as well. Thanks for your help!

                • Re: Automate creation of a sketch plane on an endpoint of a spring?
                  Artem Taturevych

                  Hi Thomas,

                   

                  Try the attached modified macro. I have put the changes between the 'MODIFICATIONS' tag.

                   

                  Thanks,
                  Artem

                  • Re: Automate creation of a sketch plane on an endpoint of a spring?
                    Andreas Killer

                    Hi Thomas,

                    I've reworked the code, take a look. The code is also attached as zip.

                    Andreas.

                     

                    Option Explicit

                     

                    Sub Main()
                      Dim xlApp As Object 'Excel.Application
                      Dim swApp As SldWorks.SldWorks
                      Dim swModel As SldWorks.ModelDoc2
                      Dim skSegment As SldWorks.SketchSegment
                     
                      Dim FileName
                      Dim RefPlanes() As SldWorks.Feature
                      Dim i As Long, j As Long
                     
                      'Ask for files
                      Set xlApp = CreateObject("Excel.Application")
                      FileName = xlApp.GetOpenFileName("Text Files (*.txt),*.txt*", , "Choose Spring Centerline Files...", , True)
                      xlApp.Quit
                      Set xlApp = Nothing
                      If Not IsArray(FileName) Then
                        MsgBox "Please select a file."
                        Exit Sub
                      End If
                     
                      Set swApp = Application.SldWorks
                      Set swModel = swApp.ActiveDoc
                      'Don't flicker with the screen
                      swModel.ActiveView.EnableGraphicsUpdate = False
                     
                      For j = LBound(FileName) To UBound(FileName)
                        'Insert the curve
                        If Not InsertCurveFile(FileName(j)) Then Exit Sub
                        'Add a ref planes at each end
                        RefPlanes = AddRefPlanes
                       
                        For i = 0 To 1
                          'Create a sketch at each end (i=0 begin i=1 end of curve)
                          RefPlanes(i).Select2 False, 0
                          swModel.SketchManager.InsertSketch True
                          Set skSegment = swModel.SketchManager.CreateCircle(0, 0, 0, 0.01, 0, 0)
                          swModel.SketchManager.InsertSketch True
                          swModel.ClearSelection2 True
                        Next
                      Next
                      'Done
                      swModel.ShowNamedView2 "", 7
                      swModel.ViewZoomtofit2
                      swModel.ActiveView.EnableGraphicsUpdate = True
                      swModel.ActiveView.GraphicsRedraw Nothing
                    End Sub

                     

                    Function InsertCurveFile(ByVal FileName As String) As Boolean
                      'Inserts as curve from a special text file
                      Dim hFile As Integer
                      Dim Contents As String, Lines, Temp
                      Dim i As Long
                      Dim X As Double, Y As Double, Z As Double
                     
                      'Be sure the file exists
                      If Dir(FileName) = "" Then Exit Function
                     
                      'Read the whole file
                      hFile = FreeFile
                      Open FileName For Binary Access Read As #hFile
                      Contents = Space(LOF(hFile))
                      Get #hFile, , Contents
                      Close #hFile
                     
                      'Split by line breaks (Note: Returned array is zero based!)
                      Lines = Split(Contents, vbCrLf)
                      'Enough lines?
                      If UBound(Lines) < 6 Then Exit Function

                     

                      Dim swApp As SldWorks.SldWorks
                      Dim swModel As SldWorks.ModelDoc2
                     
                      Set swApp = Application.SldWorks
                      Set swModel = swApp.ActiveDoc
                       
                      swModel.InsertCurveFileBegin
                      For i = 5 To UBound(Lines)
                        'Prepare the line
                        Lines(i) = Trim(Lines(i))
                        Do While InStr(Lines(i), "  ") > 0
                          Lines(i) = Replace(Lines(i), "  ", " ")
                        Loop
                        If Len(Lines(i)) > 0 Then
                          'Split by blanks
                          Temp = Split(Lines(i))
                          'Convert the values
                          X = Val(Temp(0))
                          Y = Val(Temp(1))
                          Z = Val(Temp(2))
                          swModel.InsertCurveFilePoint X / 1000, Y / 1000, Z / 1000
                        End If
                      Next
                      swModel.InsertCurveFileEnd
                      InsertCurveFile = True
                    End Function

                     

                    Function AddRefPlanes() As Variant 'SldWorks.Feature
                      Dim swApp As SldWorks.SldWorks
                      Dim swModel As SldWorks.ModelDoc2
                     
                      Set swApp = Application.SldWorks
                      Set swModel = swApp.ActiveDoc

                     

                      Dim swFeatureManager As SldWorks.FeatureManager
                      Dim swFeature As SldWorks.Feature
                      Dim swFreePointCurveFeatureData As SldWorks.FreePointCurveFeatureData
                      Dim nbrPoints As Long, i As Long
                      Dim PointArray, X As Double, Y As Double, Z As Double
                      Dim MyRefFeature(0 To 1) As SldWorks.Feature
                      Dim swRefPlane As SldWorks.RefPlane

                     

                      'Get the last item from the feature manager (the curve)
                      Set swFeatureManager = swModel.FeatureManager
                      Set swFeature = swFeatureManager.GetFeatures(True)(swFeatureManager.GetFeatureCount(True) - 1)
                      Set swFreePointCurveFeatureData = swFeature.GetDefinition
                      nbrPoints = swFreePointCurveFeatureData.GetPointCount
                      PointArray = swFreePointCurveFeatureData.PointArray
                     
                      For i = 0 To 1
                        Select Case i
                          Case 0
                            'first point
                            X = PointArray(0)
                            Y = PointArray(1)
                            Z = PointArray(2)
                          Case 1
                            'last point
                            X = PointArray(nbrPoints - 3)
                            Y = PointArray(nbrPoints - 2)
                            Z = PointArray(nbrPoints - 1)
                        End Select
                        'Select the point and the curve
                        swModel.ClearSelection2 True
                        swModel.Extension.SelectByID2 "", "POINTREF", X, Y, Z, False, 0, Nothing, 0
                        swModel.Extension.SelectByID2 swFeature.GetNameForSelection(swSelEDGES), "REFERENCECURVES", 0, 0, 0, True, 1, Nothing, 0
                        'Add the plane
                        Set swRefPlane = swFeatureManager.InsertRefPlane(4, 0, 514, 0, 0, 0)
                        'Remember for the outside world
                        Set MyRefFeature(i) = swFeatureManager.GetFeatures(True)(swFeatureManager.GetFeatureCount(True) - 1)
                      Next
                      'Return
                      AddRefPlanes = MyRefFeature
                    End Function