2 Replies Latest reply on Dec 15, 2014 10:23 AM by Matt Fisher

    How do you make a spherical body using the modeler interface?

    Matt Fisher

      I would like to write a macro that draws a sphere at a given co-ordinate. I would like to use the modeler to do this. I have found that it is quite fast at drawing boxes.

       

      This is what I have so  far. Commented lines are where the problem lies. I just don't know what the next step is. Any ideas?

       

      Option Explicit

      Sub main()

          Dim swApp As SldWorks.SldWorks

          Dim swDoc As ModelDoc2

          Dim swBody As Body2

          Dim swPart As PartDoc

          Dim swModeler As Modeler

          Dim swFeat As Feature

         

          Set swApp = Application.SldWorks

          Set swDoc = swApp.ActiveDoc

          Set swPart = swDoc

          Set swModeler = swApp.GetModeler

         

          Dim swSurf As Surface

          Dim Arr3Doubles(3) As Double

          Dim vCenter As Variant

          Dim vAxis As Variant

          Dim vRefDir As Variant

          Arr3Doubles(0) = 0: Arr3Doubles(1) = 0: Arr3Doubles(2) = 0

          vCenter = Arr3Doubles

          Arr3Doubles(0) = 0: Arr3Doubles(1) = 0: Arr3Doubles(2) = 1

          vAxis = Arr3Doubles

          Arr3Doubles(0) = 0: Arr3Doubles(1) = 1: Arr3Doubles(2) = 0

          vRefDir = Arr3Doubles

          Set swSurf = swModeler.CreateSphericalSurface2(vCenter, vAxis, vRefDir, 0.006)

       

          'Set swBody = swModeler.CreateSheetFromSurface(swSurf, Nothing)

          'swBody.Display swDoc, &HFFFFFF00

       

          'Set swFeat = swPart.CreateFeatureFromBody3(swSurf, False, swCreateFeatureBodyCheck + swCreateFeatureBodySimplify)

          'Set swFeat = swPart.CreateSurfaceFeatureFromBody(swSurf, swCreateFeatureBodyCheck + swCreateFeatureBodySimplify)

          'Set swFeat = swPart.CreateSurfaceFeatureFromBody(swSurf, 0)

          'swFeat.Name = "Datum Marker"

      End Sub

        • Re: How do you make a spherical body using the modeler interface?
          Daniel Andersson

          Had a look at it, came up with this... you missed the UVRange of the surface.

          I'm new to this part of the API in SolidWorks, so there might be other ways to create a spherical surface that I do not know about.

           

          Option Explicit

           

          Sub main()

              Dim swApp As SldWorks.SldWorks

              Dim swDoc As ModelDoc2

              Dim swBody As Body2

              Dim swPart As PartDoc

              Dim swModeler As Modeler

              Dim swFeat As Feature

            

              Set swApp = Application.SldWorks

              Set swDoc = swApp.ActiveDoc

              Set swPart = swDoc

              Set swModeler = swApp.GetModeler

            

              Dim swSurf As Surface

              Dim swSurfPara As SldWorks.SurfaceParameterizationData

              Dim Arr3Doubles(3) As Double

              Dim UVRange(3) As Double

              Dim vCenter As Variant

              Dim vAxis As Variant

              Dim vRefDir As Variant

             

              Arr3Doubles(0) = 0: Arr3Doubles(1) = 0: Arr3Doubles(2) = 0

              vCenter = Arr3Doubles

              Arr3Doubles(0) = 0: Arr3Doubles(1) = 0: Arr3Doubles(2) = 1

              vAxis = Arr3Doubles

              Arr3Doubles(0) = 0: Arr3Doubles(1) = 1: Arr3Doubles(2) = 0

              vRefDir = Arr3Doubles

             

              Set swSurf = swModeler.CreateSphericalSurface2(vCenter, vAxis, vRefDir, 0.006)

           

              Set swSurfPara = swSurf.Parameterization2

           

              UVRange(0) = swSurfPara.UMin

              UVRange(1) = swSurfPara.UMax

              UVRange(2) = swSurfPara.VMin

              UVRange(3) = swSurfPara.VMax

             

              Set swBody = swModeler.CreateSheetFromSurface(swSurf, UVRange)

           

              Set swFeat = swPart.CreateFeatureFromBody3(swBody, False, swCreateFeatureBodyCheck + swCreateFeatureBodySimplify)

              swFeat.Name = "Datum Marker"

          End Sub