AnsweredAssumed Answered

IntersectCurve in VBA - decide between real and possible intersection points

Question asked by Andreas Killer on Jun 30, 2017

Alright, maybe someone has an idea to solve this.

 

After I found the solution to get IntersectCurve to work here
http://my.solidworks.com/reader/forumthreads/207972/intersectcurve-in-vba

 

I cleaned up my code and have written a universal Function GetIntersection to return the intersection points of 2 sketch segments, works AFAIK pretty good.

 

If I look at 2 splines, the function return only the real intersection points.
But if I look at e.g. a line and a spline, the function returns the real and possible intersection points.

 

You can execute Sub Main below with an already opened sketch, it creates a line and a spline and the intersection points between both.

But only one point really intersect both.


For completeness (and followers) I attach also my whole code, which includes examples for Spline-Spline, Spline-Arc, two arbitrary items.

 

For "normal elements" like lines, arcs, circles, etc. I can think of a method by myself to calculate if a point is really located on the element... a lot of code.

But I wonder if there is a more simpler way using the API of Solidworks to decide between real and possible intersection points.

Any ideas?

 

Andreas.

 

Option Explicit

Sub Main_IntersectCurve_Line_Spline()
  Dim swApp As SldWorks.SldWorks
  Dim swModel As SldWorks.ModelDoc2
  Dim swSketchMgr As SldWorks.SketchManager
 
  Dim swSketchSegA As SldWorks.SketchSegment
  Dim swSketchSegB As SldWorks.SketchSegment

  Set swApp = Application.SldWorks
  Set swModel = swApp.ActiveDoc
  Set swSketchMgr = swModel.SketchManager

  Dim pointArray As Variant
  Dim Points() As Double
 
  'Important:
  'Snapping off!
  Dim Snapping
  Snapping = swApp.GetUserPreferenceToggle(swUserPreferenceToggle_e.swSketchInference)
  swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swSketchInference, False
 
  'Add created sketch segments directly to the SOLIDWORKS database!
  swSketchMgr.AddToDB = True

  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

  Set swSketchSegA = swSketchMgr.CreateSpline(pointArray)
  Set swSketchSegB = swSketchMgr.CreateLine(0.03, 0.04, 0#, -0.045, 0.08, 0#)
 
  pointArray = GetIntersection(swSketchSegA, swSketchSegB)
 
  If IsNull(pointArray) Then
    MsgBox "No intersection"
  Else
    Debug.Print "Points:"
    Dim i As Long
    Debug.Print "X", "Y", "Z", "K"
    For i = 0 To UBound(pointArray) Step 4
      Debug.Print pointArray(i), pointArray(i + 1), pointArray(i + 2), pointArray(i + 3)
      swSketchMgr.CreatePoint pointArray(i), pointArray(i + 1), 0#
      swModel.SketchAddConstraints "sgFIXED"
    Next
  End If
  swModel.ClearSelection2 True
 
  'Clean up
  swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swSketchInference, Snapping
  swSketchMgr.AddToDB = False
End Sub

Function GetIntersection(ByRef swSketchSegA As SldWorks.SketchSegment, ByRef swSketchSegB As SldWorks.SketchSegment, _
    Optional ByRef RealIntersection, Optional ByRef PossibleIntersection) As Variant
  'Returns an array of doubles containing the x, y, z location of the tessellation points and a code for each point
  '  Null if no intersection is found
  Dim swCurveA As SldWorks.Curve, swCurveB As SldWorks.Curve
  Dim Astart() As Variant, Aend(), Bstart() As Variant, Bend() As Variant
  Dim pointArray As Variant
 
  'Assume failure
  GetIntersection = Null
  Set swCurveA = swSketchSegA.GetCurve
  If Not GetStartEndPoint(swSketchSegA, Astart, Aend) Then Exit Function
  Set swCurveB = swSketchSegB.GetCurve
  If Not GetStartEndPoint(swSketchSegB, Bstart, Bend) Then Exit Function
 
  On Error GoTo ExitPoint
  pointArray = swCurveA.IntersectCurve(swCurveB, Astart, Aend, Bstart, Bend)
  GetIntersection = pointArray
 
  'How can I decide between real and possible intersection points here?
 
ExitPoint:
End Function

Function GetStartEndPoint(ByRef swSegment As Object, ByRef StartPoint, ByRef EndPoint) As Boolean
  'Based on https://forum.solidworks.com/message/393341
  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

Attachments

Outcomes