I can't get IntersectCurve to work in VBA... which might be due to my sketch items...
I've found some threads in here with a similar subject, but the OP use VB.NET, C# or 3DSketch... but I have a simple 2D sketch.
The code below assumes an active sketch, creates a spline and a line, which are obvious intersect. But curious:
If I call IntersectCurve to find the intersection from swCurveA to swCurveB i get a RTE -2147417848
The opposite call works, but did not return any points...
Can please someone with some experience look at the code below and give me a hint?
Andreas.
Option Explicit
Sub Main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSketchMgr As SldWorks.SketchManager
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSketchMgr = swModel.SketchManager
Dim pointArray As Variant
Dim Points() As Double
ReDim Points(0 To 14) As Double
Points(0) = 0.03
Points(1) = 0
Points(2) = 0
Points(3) = 0
Points(4) = 0.04
Points(5) = 0
Points(6) = 0.03
Points(7) = 0.08
Points(8) = 0
Points(9) = 0.06
Points(10) = 0.04
Points(11) = 0
Points(12) = 0.03
Points(13) = 0
Points(14) = 0
pointArray = Points
Dim Astart() As Variant, Aend() As Variant, Bstart() As Variant, Bend() As Variant
'Did not work either:
'Dim Astart() As Double, Aend() As Double, Bstart() As Double, Bend() As Double
Dim swSketchSegA As SldWorks.SketchSegment
Dim swCurveA As SldWorks.Curve
Set swSketchSegA = swSketchMgr.CreateSpline(pointArray)
Set swCurveA = swSketchSegA.GetCurve
If Not GetStartEndPoint(swSketchSegA, Astart, Aend) Then Exit Sub
Dim swSketchSegB As SldWorks.SketchSegment
Dim swCurveB As SldWorks.Curve
Set swSketchSegB = swSketchMgr.CreateLine(0.03, 0.04, 0#, -0.045, 0.08, 0#)
Set swCurveB = swSketchSegB.GetCurve
If Not GetStartEndPoint(swSketchSegB, Bstart, Bend) Then Exit Sub
On Error GoTo ErrorHandler
'Creates a RTE:
pointArray = swCurveA.IntersectCurve(swCurveB, Astart, Aend, Bstart, Bend)
'Works, but not points returned:
pointArray = swCurveB.IntersectCurve(swCurveA, Bstart, Bend, Astart, Aend)
If IsNull(pointArray) Then
Debug.Print "No intersection"
Else
Debug.Print "Points:"
Debug.Print Join(pointArray)
End If
Exit Sub
ErrorHandler:
Debug.Print Err.Number, Err.Description
Resume Next
End Sub
Function GetStartEndPoint(ByRef swSegment As Object, ByRef StartPoint, ByRef EndPoint) As Boolean
'Based on
Dim swSkPoint1 As SketchPoint
Dim swSkPoint2 As SketchPoint
If TypeOf swSegment Is SketchSegment Then
Select Case swSegment.GetType
Case swSketchSegments_e.swSketchLINE
Dim swSkLine As SketchLine
Set swSkLine = swSegment
Set swSkPoint1 = swSkLine.GetStartPoint2()
Set swSkPoint2 = swSkLine.GetEndPoint2()
Case swSketchSegments_e.swSketchARC
Dim swSkArc As SketchArc
Set swSkArc = swSegment
Set swSkPoint1 = swSkArc.GetStartPoint2()
Set swSkPoint2 = swSkArc.GetEndPoint2()
Case swSketchSegments_e.swSketchSPLINE
Dim swSkSpline As SketchSpline
Set swSkSpline = swSegment
Dim swSkPoints
swSkPoints = swSkSpline.GetPoints2
Set swSkPoint1 = swSkPoints(0)
Set swSkPoint2 = swSkPoints(UBound(swSkPoints))
Case swSketchSegments_e.swSketchELLIPSE
Dim swSkEllipse As SketchEllipse
Set swSkEllipse = swSegment
Set swSkPoint1 = swSkEllipse.GetStartPoint2()
Set swSkPoint2 = swSkEllipse.GetEndPoint2()
Case swSketchSegments_e.swSketchPARABOLA
Dim swParabola As SketchParabola
Set swParabola = swSegment
Set swSkPoint1 = swParabola.GetStartPoint2()
Set swSkPoint2 = swParabola.GetEndPoint2()
Case Else
Exit Function
End Select
ReDim StartPoint(0 To 2)
StartPoint(0) = swSkPoint1.X
StartPoint(1) = swSkPoint1.Y
StartPoint(2) = swSkPoint1.Z
ReDim EndPoint(0 To 2)
EndPoint(0) = swSkPoint2.X
EndPoint(1) = swSkPoint2.Y
EndPoint(2) = swSkPoint2.Z
ElseIf TypeOf swSegment Is Edge Then
Dim swEdge As Edge
Set swEdge = swSegment
Dim swCurveParamData As CurveParamData
swCurveParamData = swEdge.GetCurveParams3
StartPoint = swCurveParamData.StartPoint
EndPoint = swCurveParamData.EndPoint
Else
Exit Function
End If
GetStartEndPoint = True
Debug.Print "Start ", StartPoint(0), StartPoint(1), StartPoint(2)
Debug.Print "End ", EndPoint(0), EndPoint(1), EndPoint(2)
End Function
