AnsweredAssumed Answered

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

Question asked by Benjamin Danard on Sep 8, 2016
Latest reply on Sep 13, 2016 by 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

Outcomes