AnsweredAssumed Answered

Boundary Surface Macro(need help finishing)

Question asked by Alex Beaulier on Jan 28, 2015
Latest reply on Jan 29, 2015 by Keith Rice

I was wondering if anyone could help me in finishing this macro. I have built a set of line segments I wish to connect with the boundary surface tool. I have a midpoint of each line in Excel A1-A31, B, and C. A is the x coordinate, B is the y coordinate, and C is the z coordinate for picking the edge for Surface Boundary Connections.

 

Here is a picture of the Excel with midpoints in the first three columns, and the lines in the SolidWorks Part File.

BoundaryMacroPicture.png

 

I feel like I need to do a boolstatus = swModelDocExt.SelectByID2("", EDGE", x31, y31, z31, True, 2, Nothing, 0) at the end of the macro before it reaches the final line segment which is row 31 in my Excel Document. Does anyone see what I could improve or how to finish this?

 

Here is the macro that I have tried to build.

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSketchMgr As SldWorks.SketchManager
Dim swExcel As Excel.Application
Dim exSheet As Excel.Worksheet
Dim swSelMgr As SldWorks.SelectionMgr
Dim SwModelDocExt As SldWorks.ModelDocExtension
Dim swFeatMgr As SldWorks.FeatureManager
Dim i As Integer
Dim xpt As Double
Dim ypt As Double
Dim zpt As Double
Dim boolstatus As Boolean

 

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swExcel = GetObject(, "Excel.Application")
    Set exSheet = swExcel.ActiveSheet

    swModel.ClearSelection2 True
    Set swSelMgr = swModel.SelectionManager
    Set SwModelDocExt = swModel.Extension
   
   
i = 1
      Do While exSheet.Cells(i, 1).Value <> ""
     
       
        xpt = exSheet.Cells(i, 1).Value / 1000
        ypt = exSheet.Cells(i, 2).Value / 1000
        zpt = exSheet.Cells(i, 3).Value / 1000
     
        boolstatus = SwModelDocExt.SelectByID2("", "EDGE", xpt, ypt, zpt, False, 1, Nothing, 0)
      
          
i = i + 1

Loop

Set swFeatMgr = swModel.FeatureManager

swFeatMgr.SetNetBlendCurveData 0, 0, 0, 0, 1, True
swFeatMgr.SetNetBlendDirectionData 0, 32, 0, False, False
swFeatMgr.SetNetBlendCurveData 1, 0, 0, 0, 1, True
swFeatMgr.SetNetBlendDirectionData 1, 32, 0, False, False
swFeatMgr.InsertNetBlend 2, 1, 1, False, 0.0001, False, True, True, True, False, -1, -1, False, -1, False, False, -1, False, False, True

   
End Sub

Outcomes