8 Replies Latest reply on Jul 31, 2015 9:25 AM by Miha Zagar

    2 Edge Surface Loft

    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.

        • Re: 2 Edge Surface Loft
          Simon Turner

          I don't think you want to be using swModeler methods. They are used for creating internal surfaces that you can manipulate without affecting the Feature Manager.

          I think you need to look at the InsertLoftRefSurface2 method of ModelDoc2

          That will emulate the loft command in the user interface.

          You just need to make sure you select the input edges with "1" as the Mark.

           

            • Re: 2 Edge Surface Loft
              Miha Zagar

              Thanks. This works, but I have another problem, How do I change the start and end points ( green points):

               

              2015-07-27_1553.png

               

              This is the code so far:

               

              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
              Dim res   As Boolean
              
              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)
                  
                  Dim myEdge1e As Entity
                  Dim myEdge2e As Entity
                  Set myEdge1e = myEdge1
                  Set myEdge2e = myEdge2
                  
                  swDoc.ClearSelection2 (True)
                  Stop
                  res = myEdge1e.Select2(True, 1)
                  res = myEdge2e.Select2(True, 1)
                  
                  Stop
                  
                  swDoc.InsertLoftRefSurface2 False, False, False, 1, 0, 0
              
              
              End Sub
              
                • Re: 2 Edge Surface Loft
                  Simon Turner

                  You can use SelectionManager.SetSelectionPoint2(0, 1, x1, y1, z1) for the first edge, and SelectionManager.SetSelectionPoint2(1, 1, x2, y2, z2) for the second edge. Where x1, y1 and z1 are the coordinates of the end point on the first edge and x2, y2 and z2 are on the second edge.

                  Just in case, use SelectionManager.GetSelectedObjectCount2(1) for the index:

                   

                   

                      res = myEdge1e.Select2(True, 1) 

                  swSelMgr.SetSelectionPoint2(swSelMgr.GetSelectedObjectCount2(1), 1, x1, y1, z1)

                      res = myEdge2e.Select2(True, 1) 

                  swSelMgr.SetSelectionPoint2(swSelMgr.GetSelectedObjectCount2(1), 1, x2, y2, z2)

                    • Re: 2 Edge Surface Loft
                      Miha Zagar

                      This works great for the problem with a start point, now I have another problem. I need to select the start & end constraint vector with faces.

                      I get fliped normal on one of the faces. Is there a way to have the right orientation?

                       

                      2015-07-28_1234.png

                       

                          Dim myEdge1f1 As Face
                          Dim myEdge2f1 As Face
                          
                          ' Get the right pairs of edges
                          
                          Set myEdge1f1 = myEdge1.GetTwoAdjacentFaces2(0)
                          If myEdge1f1.Normal(2) = 1 Then
                              Set myEdge1f1 = myEdge1.GetTwoAdjacentFaces2(1)
                          End If
                          
                          Set myEdge2f1 = myEdge2.GetTwoAdjacentFaces2(0)
                          If myEdge2f1.Normal(2) = 1 Then
                              Set myEdge2f1 = myEdge2.GetTwoAdjacentFaces2(1)
                          End If
                          
                          Dim myEdge1f1e As Entity
                          Dim myEdge2f1e As Entity
                          Set myEdge1f1e = myEdge1f1
                          Set myEdge2f1e = myEdge2f1
                          
                          Dim e1v1 As Vertex
                          Dim e1v2 As Vertex
                          Set e1v1 = myEdge1.GetStartVertex
                          Set e1v2 = myEdge1.GetEndVertex
                          
                          Dim e2v1 As Vertex
                          Dim e2v2 As Vertex
                          Set e2v1 = myEdge2.GetStartVertex
                          Set e2v2 = myEdge2.GetEndVertex
                      
                          Dim v1tov1 As Double
                          Dim v1tov2 As Double
                          
                          v1tov1 = Sqr((e1v1.GetPoint(0) - e2v1.GetPoint(0)) ^ 2 + (e1v1.GetPoint(1) - e2v1.GetPoint(1)) ^ 2 + (e1v1.GetPoint(2) - e2v1.GetPoint(2)) ^ 2) + Sqr((e1v2.GetPoint(0) - e2v2.GetPoint(0)) ^ 2 + (e1v2.GetPoint(1) - e2v2.GetPoint(1)) ^ 2 + (e1v2.GetPoint(2) - e2v2.GetPoint(2)) ^ 2)
                          v1tov2 = Sqr((e1v1.GetPoint(0) - e2v2.GetPoint(0)) ^ 2 + (e1v1.GetPoint(1) - e2v2.GetPoint(1)) ^ 2 + (e1v1.GetPoint(2) - e2v2.GetPoint(2)) ^ 2) + Sqr((e1v2.GetPoint(0) - e2v1.GetPoint(0)) ^ 2 + (e1v2.GetPoint(1) - e2v1.GetPoint(1)) ^ 2 + (e1v2.GetPoint(2) - e2v1.GetPoint(2)) ^ 2)
                          
                          If v1tov2 < v1tov1 Then
                              e2v1 = e2v2
                          End If
                          
                          swDoc.ClearSelection2 (True)
                          'Stop
                          res = myEdge1e.Select2(True, 1)
                          res = swSelMgr.SetSelectionPoint2(swSelMgr.GetSelectedObjectCount2(1), 1, e1v1.GetPoint(0), e1v1.GetPoint(1), e1v1.GetPoint(2))
                          
                          res = myEdge2e.Select2(True, 1)
                          res = swSelMgr.SetSelectionPoint2(swSelMgr.GetSelectedObjectCount2(1), 1, e2v1.GetPoint(0), e2v1.GetPoint(1), e2v1.GetPoint(2))
                          
                          res = myEdge1f1e.Select2(True, 8)
                          'res = swSelMgr.SetSelectionPoint2(swSelMgr.GetSelectedObjectCount2(8), 8, e1v1.GetPoint(0), e1v1.GetPoint(1), e1v1.GetPoint(2))
                          'Debug.Print "point1: " & swSelMgr.GetSelectionPoint2(1, 8)(0) * 1000 & "  " & swSelMgr.GetSelectionPoint2(1, 8)(1) * 1000 & "  " & swSelMgr.GetSelectionPoint2(1, 8)(2) * 1000
                          
                          res = myEdge2f1e.Select2(True, 32)
                          'res = swSelMgr.SetSelectionPoint2(swSelMgr.GetSelectedObjectCount2(32), 32, e2v1.GetPoint(0), e2v1.GetPoint(1), e2v1.GetPoint(2))
                          'Debug.Print "point2: " & swSelMgr.GetSelectionPoint2(1, 32)(0) * 1000 & "  " & swSelMgr.GetSelectionPoint2(1, 32)(1) * 1000 & "  " & swSelMgr.GetSelectionPoint2(1, 32)(2) * 1000
                          
                      
                      
                          
                          swDoc.InsertLoftRefSurface2 False, False, False, 1, 2, 2
                      
                        • Re: 2 Edge Surface Loft
                          Simon Turner

                          I'm not sure, but after you have created the loft, could you get the resulting ILoftFeatureData object and use ReverseEndTangentDirection?

                           

                          Alternatively, you may have to actually create sketch lines to represent the tangent vectors.

                            • Re: 2 Edge Surface Loft
                              Miha Zagar

                              I can't assign ILoftFeatureData. Set swLoftFeatureData = swFeature.GetDefinition results in swLoftFeatureData = Nothing.

                               

                              I have created a 3D sketch to represent the vectors, selected them with a appropriate mark, but they don't show in a resulting surface loft feature.

                                • Re: 2 Edge Surface Loft
                                  Simon Turner

                                  Looks like swFeature.GetDefinition fails for surface lofts and sweeps - that needs reporting as a bug.

                                   

                                  Anyway, for you macro, without having the part file, it is difficult to see what is wrong.

                                  However, try creating a separate sketch for each sketch segment. I wonder if it is trying to select the entire sketch for each normal (and failing).

                                    • Re: 2 Edge Surface Loft
                                      Miha Zagar

                                      I have tried almost everything. SelectByRay for face selection also doesn't work.  But I have found a solution.

                                       

                                      When doing the loft manualy the faces give the correct vector direction. So I used this on selected loft feature with only edges selected:

                                       

                                          swDoc.FeatEditDef
                                         
                                          res = myEdge1f1e.Select2(True, 8)
                                          res = myEdge2f1e.Select2(True, 32)
                                          
                                          swApp.RunCommand swCommands_Ok_Command, ""
                                      

                                       

                                      This sets the correct vectors. So this problem is solved. Thank you.