2 Replies Latest reply on Sep 13, 2016 6:39 PM by Benjamin Danard

    Can't create points after making a sketch (VBA)

    Benjamin Danard

      Hello everyone,

       

      I'm working on a project for work, where we have an XYZ table on an excel sheet and use it to create a 3D model of a bent tube. The program draws the lines, adds the bend radius, and then extrudes a circle profile over the path.

       

      I'm running into an issue when dealing with pipes that are not perpendicular to one of the three default planes. In those cases I want to create a plane perpendicular to the end of the cable and use that as my sketch plane.

       

      My problem:

      I'm trying to use CreatePlaneThru3Points3 to take three points perpendicular to the line and make a plane from them. However whenever  I try to do this in my code it fails to create a new sketch.

       

      Thanks for taking the time to read my question.

       

      ------------------------------- My XYZ + Radius table

       

      PointsXYZR
      1000
      20100.14
      301-10.14
      402-10.14
      522-10

       

      ------------------------------- My code is as follows (This is in a module in Excel)

      Sub CreateTube

       

          Dim swApp As SldWorks.SldWorks
          Dim Part As ModelDoc2
          Dim i As Integer
         
          Set swApp = CreateObject("SldWorks.Application")
         
          Set Part = swApp.ActiveDoc
          If Part Is Nothing Then
              MsgBox "Please activate a part document before using this macro."
              Exit Sub
          End If
          If Part.GetType <> 1 Then
              MsgBox "Please activate a part document before using this macro."
              Exit Sub
          End If
          If Not Part.GetActiveSketch2 Is Nothing Then
              MsgBox "Please exit the sketch before running this macro."
              Exit Sub
          End If
         
          Dim ConversionFactor As Double, Thickness As Double
          Dim Lastrow As Double
          Lastrow = Range("K6").Value + 1
         
          ConversionFactor = 0.0254
          Thickness = Range("H3").Value / 2
         
          ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Create Main cable <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
         
          Part.ClearSelection2 True
          Part.Insert3DSketch
          Part.SetAddToDB True
         
          ' Create the straight line path of the cable
         
          i = 3
         
          While Range("B" & i).Value <> ""
              Set mySeg2 = Part.CreateLine2(Range("B" & i - 1).Value * ConversionFactor, Range("C" & i - 1).Value * ConversionFactor, Range("D" & i - 1).Value * ConversionFactor, Range("B" & i).Value * ConversionFactor, Range("C" & i).Value * ConversionFactor, Range("D" & i).Value * ConversionFactor)
              i = i + 1
          Wend
         
          ' Add bends to the path
          i = 3
             While Range("B" & i + 1).Value <> ""
              boolstatus = Part.Extension.SelectByID2("Point2", "SKETCHPOINT", Range("B" & i).Value * ConversionFactor, Range("C" & i).Value * ConversionFactor, Range("D" & i).Value * ConversionFactor, False, 0, Nothing, 0)
              Dim skSegment As Object
              Set skSegment = Part.SketchManager.CreateFillet(Range("E" & i).Value * ConversionFactor, 1)
              i = i + 1
          Wend
          Part.ClearSelection2 True
          ' Create Plane 1 perpendicular to fwd end
         
          Dim swSketchPt1 As SldWorks.SketchPoint
          Dim swSketchPt2 As SldWorks.SketchPoint
          Dim swSketchPt3 As SldWorks.SketchPoint
          Dim swPlane As SldWorks.RefPlane
          Dim bRet As Boolean
         
          Set swmodel = swApp.ActiveDoc
          Set swSelMgr = swmodel.SelectionManager
          Set swSelData = swSelMgr.CreateSelectData
          Set swAssy = swmodel
         
          Part.Insert3DSketch
          Part.SetAddToDB True

          Set swSketchPt1 = Part.SketchManager.CreatePoint2(0 / 1000, 0 / 1000, 0 / 1000)
          Set swSketchPt2 = Part.SketchManager.CreatePoint2(1 / 1000, 0 / 1000, 1 / 1000)
          Set swSketchPt3 = Part.SketchManager.CreatePoint2(-1 / 1000, 0 / 1000, -1 / 1000)

          Part.Insert3DSketch2 True
          Part.ClearSelection2 True

          bRet = swSketchPt1.Select4(True, swSelData): Debug.Assert bRet
          bRet = swSketchPt2.Select4(True, swSelData): Debug.Assert bRet
          bRet = swSketchPt3.Select4(True, swSelData): Debug.Assert bRet

          Set swPlane = Part.CreatePlaneThru3Points3(True)

       

      End sub

        • Re: Can't create points after making a sketch (VBA)
          Keith Rice

          I'm trying to use CreatePlaneThru3Points3 to take three points perpendicular to the line and make a plane from them. However whenever I try to do this in my code it fails to create a new sketch.

          I'm guessing this was a typo, but IModelDoc2::CreatePlaneThru3Points3 creates a plane, not a sketch.

           

          Also, are you aware that this method is obsolete? You might want to consider using IFeatureManager::InsertRefPlane.

           

          Anyway, as general SolidWorks API programming advice, I would recommend you create a macro that does nothing more than create a plane using IFeatureManager::InsertRefPlane from three existing points in an otherwise blank part. This will let you focus on the problem at hand and then once it is working you can merge it into your existing code.

           

          By the way, we have created custom tube / pipe creation software like this, so if you're looking to bring in some experts on this project, please check out our Services page at the link below.

           

          Keith

          SolidWorks API Training and Services