AnsweredAssumed Answered

2 Edge Surface Loft

Question asked by Miha Zagar on Jul 27, 2015
Latest reply on Jul 31, 2015 by Miha Zagar

I need a macro that creates a surface loft from two body edges:

2015-07-27_0945.png

I have the following code (this topic was used as a reference: https://forum.solidworks.com/thread/53800):

 

Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swSketch As SldWorks.Sketch
Dim vSegs As Variant
Dim vSeg As Variant
Dim swSeg As SldWorks.SketchSegment
Dim swModel As Object

Sub main()
    ' Initialize Solidworks objects
    Set swApp = Application.SldWorks
    Set swDoc = swApp.ActiveDoc
    Set swSketch = swDoc.SketchManager.ActiveSketch
    Set swModel = swApp.ActiveDoc
    Dim swSelMgr As SldWorks.SelectionMgr
    Set swSelMgr = swModel.SelectionManager
    Dim myEdge1 As Edge
    Dim myEdge2 As Edge
    Set myEdge1 = swSelMgr.GetSelectedObject5(1)
    Set myEdge2 = swSelMgr.GetSelectedObject5(2)
    Stop
    ' Create points from beginnings of spline curves
    Dim Curve As Object
    Dim PointsObject As Variant
    Dim LocStart0 As Object
    Dim LocStart1 As Object
    Dim boolstatus As Boolean
    ' Select curve 0
    Set Curve = myEdge1.GetCurve()
    Set LocStart0 = myEdge1.GetStartVertex
    ' Select curve 1
    Set Curve = myEdge2.GetCurve()
    Set LocStart1 = myEdge2.GetStartVertex
    ' variables for CreateLoftSurface
    Dim swModeler As IModeler
    Dim CurveArray(2) As Object
    Dim BBlendClosed As Boolean
    Dim BForceCubic As Boolean
    Dim GuideCrvArray As Object
    Dim StartMatchingType As Integer
    Dim EndMatchingType As Integer
    Dim NormalAtStartSection As Object
    Dim NormalAtEndSection As Object
    Dim StartMatchingFaceList As Object
    Dim EndMatchingFaceList As Object
    Dim DegeneratedStart As Boolean
    Dim DegeneratedEnd As Boolean
    Dim StartPointOfStartSection As Object
    Dim StartPointOfEndSection As Object
    Dim SectionIndexStart As Integer
    Dim SectionIndexEnd As Integer
    Dim GuideIndexStart As Integer
    Dim GuideIndexEnd As Integer
    Dim LoftSurface As Object

    Set CurveArray(0) = myEdge1.GetCurve()    ' Sets first curve
    Set CurveArray(1) = myEdge2.GetCurve()    ' Sets second curve
    BBlendClosed = False            ' False for non-closed
    BForceCubic = False             ' False for not forcing cubic surface
    Set GuideCrvArray = Nothing     ' Don't have a guide curve
    StartMatchingType = 0           ' Match none
    EndMatchingType = 0             ' Match none
    Set NormalAtStartSection = Nothing  ' Not used
    Set NormalAtEndSection = Nothing    ' Not used
    Set StartMatchingFaceList = Nothing ' Not used
    Set EndMatchingFaceList = Nothing   ' Not used
    DegeneratedStart = False            ' Not used
    DegeneratedEnd = False              ' Not used
    Set StartPointOfStartSection = LocStart0    'Start point of curve 0
    Set StartPointOfEndSection = LocStart1      'Start point of curve 1
    SectionIndexStart = 0
    SectionIndexEnd = 1
    GuideIndexStart = -1
    GuideIndexEnd = -1
    Stop
    ' Create the surface loft
    Set swModeler = swApp.GetModeler
    Set LoftSurface = swModeler.CreateLoftSurface(CurveArray, BBlendClosed, BForceCubic, GuideCrvArray, StartMatchingType, EndMatchingType, NormalAtStartSection, NormalAtEndSection, StartMatchingFaceList, EndMatchingFaceList, DegeneratedStart, DegeneratedEnd, StartPointOfStartSection, StartPointOfEndSection, SectionIndexStart, SectionIndexEnd, GuideIndexStart, GuideIndexEnd)
End Sub

The problem is in the function swModeler.CreateLoftSurface. It makes Solidworks crash. I have SW2015SP4.

Thank you.

Outcomes