5 Replies Latest reply on Jul 30, 2018 4:40 PM by Josh Brady

    Generating random sphere

    Peter Johnson

      hi , i currently working on a project and i have to generate sphere in different position like in the figure. im doing this by using visual studio and solidworks. the problem  is im unable to generate the sphere away from the plane


      Message was edited by: Peter Johnson

        • Re: Generating random sphere
          Josh Brady

          Good for you!  Sounds like fun.

          • Re: Generating random sphere
            Tony Tieuli

            Peter Johnson wrote:


            hi , i currently working on a project and i have to generate sphere in different position

            So is there a question in there?

              • Re: Generating random sphere
                Peter Johnson

                yes sorry. the thing is am  trying to code it in visual studio i am only able to generate the sphere in a plane so my question was is there a way to generate the sphere without a plane

                  • Re: Generating random sphere
                    Josh Brady

                    I already wrote and posted your whole macro almost 3 years ago... 



                      • Re: Generating random sphere
                        Josh Brady

                        Here's the version if you want solids.  All I did was add Import Diagnostics to the end of the macro.


                        Note that there's no checking for overlap, or even one sphere entirely containing another.


                        Option Explicit
                        Const SphereMax As Double = 0.05 '(50mm)
                        Const BoxSize As Double = 1 ' (1m)
                        Const NumSpheres As Long = 100
                        Const MAKESOLIDS As Boolean = True
                        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
                            Dim i As Long
                            Dim StopWatch As Double
                            If MsgBox("About to create " & NumSpheres & " spheres.  Continue?", vbYesNo) = vbNo Then Exit Sub
                            StopWatch = Timer
                            For i = 1 To NumSpheres
                                Arr3Doubles(0) = RC(BoxSize): Arr3Doubles(1) = RC(BoxSize): Arr3Doubles(2) = RC(BoxSize)
                                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, RC(SphereMax))
                                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 = "Sphere_" & i
                            Next i
                            If MAKESOLIDS Then
                                swDoc.ImportDiagnosis True, False, True, 0
                            End If
                            MsgBox "Finished in " & Round(Timer - StopWatch, 2) & " seconds."
                        End Sub
                        Function RC(ByVal MyMax As Double)
                        RC = MyMax * Rnd
                        End Function