2 Replies Latest reply on Jun 24, 2016 3:29 PM by Bjorn Sorenson

    API Help Request, Change 3D Sketch Line Color from Text Input

    Bjorn Sorenson

      Hello All,

       

      I'm currently using the attached macro to take a 6 column text file and plot vectors as lines (in SW 2013).  The columns are X1, Y1, Z1 (vector origin coordinates) and X2, Y2, Z2 (vector endpoint coordinates).  I'd like to add a seventh column with either a 1 or a 0 for each row, and have SW make the sketch line for the rows with a 1 in blue, and the rows with a 0 in red.  Is this possible?  Thanks!!!

        • Re: API Help Request, Change 3D Sketch Line Color from Text Input
          Andreas Killer

          Sub Main()
            Dim swApp As SldWorks.SldWorks
            Dim Part As SldWorks.ModelDoc2
            Dim skSegment As SldWorks.SketchSegment
            Dim ThisLine As String, Arr As Variant
            Dim i As Integer

           

            Set swApp = Application.SldWorks
            Set Part = swApp.ActiveDoc

           

            swApp.ActiveDoc.ActiveView.FrameState = 1

           

            Open "C:\Users\Killer\Documents\Downloads\Plot Velocity Vectors.swp\Test.txt" For Input As #1
            Part.SketchManager.Insert3DSketch True
            Do While Not EOF(1)
              'Read the whole line
              Input #1, ThisLine
              'Split by tab chars
              Arr = Split(ThisLine, vbTab)
              'Convert the 1st six numeric values
              For i = 0 To 5
                Arr(i) = CDbl(Arr(i)) * 0.0254
              Next
              'Create the line
              Set skSegment = Part.SketchManager.CreateLine(Arr(0), Arr(1), Arr(2), Arr(3), Arr(4), Arr(5))
              'Do we have a color?
              If UBound(Arr) > 5 Then
                Select Case Arr(6)
                  Case 0
                    skSegment.Color = vbRed
                  Case 1
                    skSegment.Color = vbBlue
                  Case Else
                    skSegment.Color = RGB(255, 255, 255) 'White
                End Select
              End If
            Loop
            Close #1
           
            With Part
              .ClearSelection 'True
              .ShowNamedView2 "", 7
              .ViewZoomtofit2
            End With
          End Sub