2 Replies Latest reply on Nov 13, 2018 2:33 PM by Justin Holder

    Lofted Boss/Base via VBA macro

    Justin Holder

      I'm new to the forum and have tried more times than I can count to figure out my problem. So far I can perform the outlined below process by using the GUI for creating a rotor blade and section of the hub wheel. The steps are

       

      1) Insert Curve by XYZ points: I have 21 3D closed section curves which are essentially 3D airfoils (e.g., secCrv1.sldcrv through secCrv21.sldcrv) which show as Curve1 through Curve21 in the Feature Tree.

      2) I then create fill-surfaces for the first and last section curves (Curve1 and Curve21, respectively)

      3) There are then 24 additional 3D curves that serve as guide curves that I insert by XYZ points found in *.sldcrv files which create Curve22 through Curve45

      4) I select Lofted Boss/Base. The profiles are, in order: Surface-Fill1, Curve2 through Curve20, and Surface-Fill2. The guide curves are Curve22 through Curve45

      5) The created loft generates a rotor blade

      6) A similar process creates the hub wheel

       

      So far I've figured out how to do all of the above steps through a macro EXCEPT creating the loft. I've attempted using CreateLoftBody2 as well as InsertProtrusionBlend2 with no success. I'm hoping to replicate the exact process I do in the GUI within a macro. Can anyone shed some light on what I'm doing wrong? Note that I'm currently using version 2016. Also, attached is my macro (also shown below). I appreciate any and all advice as I'm at my wits end trying to figure this out.Thanks!!!

       

      ***EDIT***

       

      When I run the below macro (with the lines regarding lofting commented out) I then get a "skeletal" shape of my geometry as shown in pic 1. There are many curves and 4 surfaces (non-planar). The surfaces serve as profiles to loft between.

      Pic 1:

      SWscriptCurrent.PNG

       

      With the script completed, I then have to manually select "Lofted Boss/Base" within the GUI (this is the part I'd like to incorporate into the macro). The loft preview is shown in pic 2.

      Pic 2:

      SWloftSelections.PNG

       

      After accepting the loft, the completed blade is shown in pic 3.

      Pic 3:

      SWloftBlade.PNG

       

      With the blade loft completed, several similar steps are performed to complete the section of the rotor hub disk. These operations include a "Lofted Boss/Base" (similar to above) to complete the the rotor hub disk, an "Extruded Cut" of a cylinder along the rotation axis (e.g., a circle is drawn on the "Right Plane," and the extruded cut is "Through All - Both"), and lastly a fillet is added to the blade root. Pic 4 shows the completed geometry.

      Pic 4:

      SWfinal.PNG

       

      Dim swApp As SldWorks.SldWorks

      Dim swModel As SldWorks.ModelDoc2

      Dim swModelExt As SldWorks.ModelDocExtension

      Dim swFeatMgr As SldWorks.FeatureManager

      Dim swFeat As SldWorks.Feature

      Dim swSelMgr As SldWorks.SelectionMgr

      Dim swSelObj As Object

      Dim swModeler As SldWorks.Modeler

      Dim swPart As PartDoc

      Dim swBody As SldWorks.Body2

      Dim myModelView As Object

      Dim filePath As Variant

      Dim boolstatus As Boolean

      Dim num1 As Integer

      Dim num2 As Integer

      Dim num3 As Integer

      Dim num4 As Integer

      Dim num5 As Integer

      Dim num6 As Integer

      Dim nsec As Integer

      Dim nguide As Integer

      Dim nprofiles As Integer

      Dim nguides As Integer

      Dim file As Variant

      Dim profiles As Variant

      Dim profile() As Object

      Dim guides As Variant

      Dim guide() As Object

      Dim count As Integer

      Dim guideMark As Variant

      Dim int1 As Integer

      Dim vFeat As Variant

       

       

      Sub main()

       

      'Open SolidWorks and create a new part. Note that T-Blade3 is in units of millimeters

      'and the MATLAB scripts that create the *.sldcrv files coverted to meters. So you'll need

      'to create a part template in MKS and set that template as the default

      Set swApp = Application.SldWorks

      swApp.NewPart

      Set swModel = swApp.ActiveDoc

      Set myModelView = swModel.ActiveView

      myModelView.FrameState = swWindowState_e.swWindowMaximized

       

      'filePath where *.sldcrv files are located

      filePath = "C:\Users\Justin\Documents\NASA\nasatct_EXPL_AXI_3IRO_5_3_1\Row2\"

       

      nsec = 21 'Number of section curves output by T-Blade3 (3DBGB)

       

      'This loop inserts the secCrv#.sldcrv files as curve through XYZ points

      For num1 = 1 To nsec

      file = filePath & "secCrv" & num1 & ".sldcrv"

      boolstatus = swModel.InsertCurveFile(file)

      Next num1

       

      Set swModelExt = swModel.Extension 'enable ModelDocExtension

       

      'Clear all selected items

      swModel.ClearSelection2 True

       

      'Select the first section curve and create a capping surface for lofting

      boolstatus = swModelExt.SelectByID2("Curve1", "REFCURVE", 0, 0, 0, True, 257, Nothing, swSelectOptionDefault)

      Set swSelMgr = swModel.SelectionManager

      Set swSelObj = swSelMgr.GetSelectedObject6(1, 257)

      Set swFeatMgr = swModel.FeatureManager

      Set swFeat = swFeatMgr.InsertFillSurface2(2, swOptimizeSurface, swSelObj, swContact, Nothing, Nothing)

       

      'Clear all previously selected items

      swModel.ClearSelection2 True

       

      'After selections are cleared, create the final capping surface for lofting

      'using the last section curve

      boolstatus = swModelExt.SelectByID2("Curve" & nsec, "REFCURVE", 0, 0, 0, True, 257, Nothing, swSelectOptionDefault)

      Set swSelObj = swSelMgr.GetSelectedObject6(1, 257)

      Set swFeat = swFeatMgr.InsertFillSurface2(2, swOptimizeSurface, swSelObj, swContact, Nothing, Nothing)

       

      swModel.ClearSelection2 True

       

      nguide = 24 'The number of guide curves to be inserted

       

      'This loop inserts the guideCrv#.sldcrv files as curve through XYZ points

      For num2 = 1 To nguide

      file = filePath & "guideCrv" & num2 & ".sldcrv"

      boolstatus = swModel.InsertCurveFile(file)

      Next num2

       

      swModel.ClearSelection2 True

       

      nprofiles = (nsec - 1)

       

      ReDim profile(nprofiles)

       

       

      For num3 = 1 To nsec

      If num3 = 1 Then

      boolstatus = swModelExt.SelectByID2("Surface-Fill1", "SURFACEBODY", 0, 0, 0, True, 1, Nothing, swSelSURFACEBODIES)

      ElseIf num3 = nsec Then

      boolstatus = swModelExt.SelectByID2("Surface-Fill2", "SURFACEBODY", 0, 0, 0, True, 1, Nothing, swSelSURFACEBODIES)

      Else

      boolstatus = swModelExt.SelectByID2("Curve" & num3, "REFCURVE", 0, 0, 0, True, 1, Nothing, swSelREFCURVES)

      End If

      Set swSelObj = swSelMgr.GetSelectedObject6(1, -1)

      Set profile(num3 - 1) = swSelObj

      swModel.ClearSelection2 True

      Next num3

       

      profiles = profile

       

      swModel.ClearSelection2 True

       

      nguides = (nguide - 1)

       

      ReDim guide(nguides)

       

      count = 0

      For num4 = (nsec + 1) To (nsec + nguide)

      boolstatus = swModelExt.SelectByID2("Curve" & num4, "REFCURVE", 0, 0, 0, True, 2, Nothing, swSelectOptionDefault)

      Set swSelObj = swSelMgr.GetSelectedObject6(1, -1)

      Set guide(count) = swSelObj

      swModel.ClearSelection2 True

      count = (count + 1)

      Next num4

       

      guides = guide

      'Set swFeat = swFeatMgr.InsertProtrusionBlend2(True, True, True, 1, 3, 3, 0, 0, True, True, False, 0, 0, 0, True, False, False, swGuideCurveInfluence_e.swGuideCurveInfluenceNextGuide)

       

      Set swModeler = swApp.GetModeler

      Set swBody = swModeler.CreateLoftBody2(swModel, profiles, guides, Nothing, False, 0, 0, 0, True, False, True, False, True, 1#, 0, 0, True, True, 0, 0, True)

       

      Set swPart = swModel

      vFeat = swPart.CreateSurfaceFeatureFromBody(swBody, swCreateFeatureBodyOpts_e.swCreateFeatureBodyCheck)

      ''swModel.InsertLoftRefSurface2 True, False, True, 1, 0, 0

      swModel.EditRebuild3

      swModel.ClearSelection2 True

       

       

      'Insert the left side curves of the hub wedge including the rotation axis

      file = filePath & "inletLE.sldcrv"

      boolstatus = swModel.InsertCurveFile(file)

      file = filePath & "mlLE.sldcrv"

      boolstatus = swModel.InsertCurveFile(file)

      file = filePath & "outletLE.sldcrv"

      boolstatus = swModel.InsertCurveFile(file)

      file = filePath & "rotationAxis.sldcrv"

      boolstatus = swModel.InsertCurveFile(file)

       

      'Select the left side wedge curves and mark with "257" in order to use fill surface

      For num5 = (nsec + nguide + 1) To (nsec + nguide + 4)

      boolstatus = swModelExt.SelectByID2("Curve" & num5, "REFCURVE", 0, 0, 0, True, 257, Nothing, swSelectOptionDefault)

      Next num5

       

      'Grab curves marked "257" and create a fill surface with them

      Set swSelObj = swSelMgr.GetSelectedObject6(1, 257)

      Set swFeat = swFeatMgr.InsertFillSurface2(2, swOptimizeSurface, swSelObj, swContact, Nothing, Nothing)

       

      swModel.ClearSelection2 True

       

      'Insert right side wedge curves

      file = filePath & "inletRE.sldcrv"

      boolstatus = swModel.InsertCurveFile(file)

      file = filePath & "mlRE.sldcrv"

      boolstatus = swModel.InsertCurveFile(file)

      file = filePath & "outletRE.sldcrv"

      boolstatus = swModel.InsertCurveFile(file)

       

      'Select rotation axis curve and other right side wedge curves and mark with "257"

      'in order to use fill surface

      For num6 = (nsec + nguide + 4) To (nsec + nguide + 7)

      boolstatus = swModelExt.SelectByID2("Curve" & num6, "REFCURVE", 0, 0, 0, True, 257, Nothing, swSelectOptionDefault)

      Next num6

       

      'Grab objects marked "257" and insert fill surface with them

      Set swSelObj = swSelMgr.GetSelectedObject6(1, 257)

      Set swFeat = swFeatMgr.InsertFillSurface2(2, swOptimizeSurface, swSelObj, swContact, Nothing, Nothing)

       

      file = filePath & "inletArc.sldcrv"

      boolstatus = swModel.InsertCurveFile(file)

      file = filePath & "outletArc.sldcrv"

      boolstatus = swModel.InsertCurveFile(file)

       

      swModel.ClearSelection2 True

       

      swModel.ShowNamedView2 "*Isometric", 7

      swModel.ViewZoomtofit2

      End Sub

       

      Message was edited by: Justin Holder, *.sldcrv files attached