19 Replies Latest reply on Jun 7, 2017 10:36 PM by Ali Moeini

    Multiple spheres in the same file

    Antony Edilbert

      Hi. I need to create a model imitating a particle bed. I have the diameter and x,y,z positions of the particles. There are totally 30000+ particles. Please help

        • Re: Multiple spheres in the same file
          Jody Stiles

          Hi Anthony,

           

          This took me a couple of minutes to figure out how to do it but you can use the Variable Pattern we added in 2015 to accomplish this.  It's not straight forward but it's fairly easy to do.  The attached model has the first 100 or so data points in it.  To get the 30,000+ you want, you'll have to run that yourself and let the machine churn for a while if it can complete it at all.  An alternate approach might be to model up several chunks of the data and combine them using insert part in part or create an assembly.

           

          The approach I took was to

          1. Shift your data points by 2,000mm (I assumed mm) since SOLIDWORKS will not handle negative dimensions in 3D Sketch so they all need to be positive for my approach
          2. Create a block larger than the data points require
          3. Create a 3D Sketch defining the first point in your data set
          4. Create a Plane at the point
          5. Create a Revolved Cut (diameter defined in your spreadsheet) at that point on the plane
          6. Use the Variable Pattern and import the Excel spreadsheet data into the pattern table
          7. Create a second block, same as the one in #2 above but turn off the Merge result option so that it creates two distinct bodies
          8. Select the two bodies from the Solid Bodies folder, RMB > Combine > Subtract > Main body = the second block, Bodies to Combine = the first block with the spherical cut in it > OK

           

          You now get the negative space of the combine which is your desired spherical body pattern.  The reason for the two bodies is that Variable Pattern will not create distinct bodies on it's own, it needs to merge the feature being patterned with a base body.  I've attached the 2016 model and various spreadsheets below.

           

           

          Hopefully this helps,

          Jody

          • Re: Multiple spheres in the same file
            Rob Edwards

            This is a curious problem.  There is an approach I take for solving a much smaller problem (20-30) that I thought might work, and I wanted to see how far it would go.  I'm not sure if it will help you but I think it has some interesting results.  I never work with very large assemblies so I would like to learn if there is a better way to work this method.

             

            The first thing I did was create an assembly and insert a part.

            I then made two reference planes for each of the standard planes in the assembly.  The offset was equal to the ABS value of x, y and z

            (The reason for this is to get around the limitation of negative values, and linear assembly patterns.. more later)

             

             

            I then made a 3d sketch point coincident to *all* the planes.

            Obviously this would cause an error, so I suppressed each relation.  The DT can then control which relation is active according to the values of x, y and z being positive or negative

            A revolve based on your radius size and a body move copy from the part origin to 3d sketch point finished the modelling side of the part.

             

            To get your data into the model I just copy/pasted into a DT.  The idea is to create a new configuration for each sphere.

            I just pull your data on the right straight into the model dimensions, and suppress or unsuppress the relevant sketch relation.

            I succeeded with 1000 configurations, so tried to push it further.  The DT successfully created 10,000 configs. (back to that later)

             

            So back in the assembly I used a linear pattern to create a 1000 parts.  I am unaware of how to make multiple copies of a part without a translation.  When you enter 0 for D1 SW does not accept the input.  If there is a way to create 1000's of copies of parts all in the same location it would make this a lot simpler as I wouldn't need to create references to the assembly - you could use the parts origin directly.

             

            Anyway now all I had to do was change each parts config.  I used another DT in the assembly, making the instance id and config name the same.

             

            I haven't really tested it to see if the geometry is accurate but for 1000 components it worked pretty quick

            When I bumped it up to 10000 configs, SW appeared to still be working but it took such a long time I don't know if it had crashed.

            The DT could create 10000 configs but when I tried to rebuild all active configs it 'hung' up.

            It also 'hung' up when I tried to linear pattern 10,000 parts.

            From looking at Windows Task manager SW still seemed active.  There was processor activity and the memory usage was changing, but I don't know how long these things would take, so just cancelled it when I'd finished my cup of tea.

             

            As I said I have no experience of large assemblies - I'm guessing I can set all the parts to lightweight or something.  I also probably should have saved the part out - this was still a virtual part

             

            I saved the assembly as a part, but when I opened it there were only 977 surface bodies.  I'm not sure why this is.  Could it be duplicate data?

             

             

            I adopted this technique because I thought it was a way of using your data directly 'as is'.  I'm guessing simplifying it, using a model offset to avoid the negative values would be worth it.  Maybe someone might be able to add to this.  I did a search on the forum and I couldn't find a limit to the number of configs or parts that are possible

             

            I also have an entirely new approach that I would like to try out.  I'll post it if I get any joy

            • Re: Multiple spheres in the same file
              Josh Brady

              So... Do you have any skills?  Nunchuck skills? Bow hunting skills?  Computer hacking (VBA) skills?

              I wrote a macro some time ago to create spheres directly with the modeler.  It's here:

              https://forum.solidworks.com/message/547024#comment-547024

               

              It just creates random spheres within a cube.  However, it would be trivial to modify it to read an Excel file for dimensions instead of making them random.

               

              Interestingly enough, Shaodun Lin just liked that content over there, but didn't mention it here.  maybe he tried it out and it takes too long.

               

              Edit:

               

              So I went ahead and did it.  I'll let my computer work overnight and see how many it can create.

               

              If you want to try it for yourself, you will need to edit the constant at the top for the Excel path.

              Preconditions: A part file is open and active in SolidWorks.

              The macro will ask you if you want to do the entire file or just the first 100.

              I assumed column A is diameter and B-D are X-Z, with values in MM.  YMMV.

              The status bar updates you on the progress every 10 spheres.

              Option Explicit
              
              
              Const REPORTINTERVAL As Long = 10
              Const XLPATH As String = "C:\JoshFiles\Macro\SphereIt\Coords.xlsx"
              Const SphereMax As Double = 0.05 '(50mm)
              Const SF As Double = 0.001 'multiplier to change mm to m
              Const BoxSize As Double = 1 ' (1m)
              Const NumSpheres As Long = 100
              Dim xlApp As Object
              Dim xlBook As Object
              Dim xlSht As Object
              Dim swPane As SldWorks.StatusBarPane
                
                
                
              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
                  Set swPane = swApp.Frame.GetStatusBarPane
                
                  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
                  Dim DoEmAll As Long
                  
                  'Create XL
                  Set xlApp = CreateObject("Excel.Application")
                  Set xlBook = xlApp.Workbooks.Open(XLPATH)
                  Set xlSht = xlApp.ActiveSheet
                    
                
                  Randomize
                
                  DoEmAll = MsgBox("Do all spheres?  Choosing ""No"" will only do first " & NumSpheres & _
                          vbCrLf & "Window will hide to improve performance.", vbYesNo)
                    
                  StopWatch = Timer
                  i = 1
                  swDoc.Visible = False
                  Do While xlSht.Cells(i, 1).Value <> ""
                      Arr3Doubles(0) = xlSht.Cells(i, 2).Value * SF: Arr3Doubles(1) = xlSht.Cells(i, 3).Value * SF: Arr3Doubles(2) = xlSht.Cells(i, 4).Value * SF
                      vCenter = Arr3Doubles
                      Arr3Doubles(0) = 0: Arr3Doubles(1) = 0: Arr3Doubles(2) = 1
                      vAxis = Arr3Doubles
                      Arr3Doubles(0) = 0: Arr3Doubles(1) = 1: Arr3Doubles(2) = 0
                      vRefDir = Arr3Doubles
                        
                        'post states file contains diameter. Therefore divide by 2 in sphere creation for radius.
                      Set swSurf = swModeler.CreateSphericalSurface2(vCenter, vAxis, vRefDir, xlSht.Cells(i, 1).Value * SF / 2)
                    
                      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, 0) 'swCreateFeatureBodyCheck + swCreateFeatureBodySimplify)
                    
                      swFeat.Name = "Sphere_" & i
                      i = i + 1
                      If i Mod REPORTINTERVAL = 0 Then
                          swPane.Text = "Spheres created: " & i & " (Updates every " & REPORTINTERVAL & ")"
                      End If
                      If (DoEmAll = vbNo) And (i > NumSpheres) Then Exit Do
                  Loop
                  Set xlSht = Nothing
                   Set xlBook = Nothing
                   xlApp.Quit
                   Set xlApp = Nothing
                   Set swPane = Nothing
                swDoc.Visible = True
                swDoc.ViewZoomtofit
                  MsgBox "Finished in " & Round(Timer - StopWatch, 2) & " seconds."
                
              End Sub
              
                • Re: Multiple spheres in the same file
                  Josh Brady

                  So my computer is now up to 7,600 some odd spheres in a single part file.  It is dragging pretty bad, although it's still chugging away. As I mentioned in the previous thread, the more spheres you have the longer it takes to create each sphere.  I think it would take forever to get to 30k, and of course if it does crash there's no saved progress. 

                   

                  I think I'm going to kill it and see if I can tweak the code to save partway though and start a new file.  Maybe about 3k spheres per part.

                    • Re: Multiple spheres in the same file
                      Josh Brady

                      Seems to have worked mostly correctly.  Ran overnight and created files of 1000 spheres each.  Something crashed during the 30001 through 31000 file, but I don't have time to debug. All files dropped into a new assembly looks like this:

                       

                       

                      Option Explicit
                      
                      
                      Const REPORTINTERVAL As Long = 10
                      Const SPHERESPERFILE As Long = 1000
                      Const XLPATH As String = "C:\JoshFiles\Macro\SphereIt\Coords.xlsx"
                      Const SphereMax As Double = 0.05 '(50mm)
                      Const SF As Double = 0.001 'multiplier to change mm to m
                      Const BoxSize As Double = 1 ' (1m)
                      Const NumSpheres As Long = 105
                      Dim xlApp As Object
                      Dim xlBook As Object
                      Dim xlSht As Object
                      Dim swPane As SldWorks.StatusBarPane
                        
                        
                        
                      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
                          Set swPane = swApp.Frame.GetStatusBarPane
                        
                          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
                          Dim DoEmAll As Long
                          Dim LastSaved As Long
                          
                          'Create XL
                          Set xlApp = CreateObject("Excel.Application")
                          Set xlBook = xlApp.Workbooks.Open(XLPATH)
                          Set xlSht = xlApp.ActiveSheet
                            
                        
                          Randomize
                        
                          DoEmAll = MsgBox("Do all spheres?  Choosing ""No"" will only do first " & NumSpheres & _
                                  vbCrLf & "Window will hide to improve performance.", vbYesNo)
                            
                          StopWatch = Timer
                          i = 1
                          swDoc.Visible = False
                          LastSaved = 1
                          Do While xlSht.Cells(i, 1).Value <> ""
                              Arr3Doubles(0) = xlSht.Cells(i, 2).Value * SF: Arr3Doubles(1) = xlSht.Cells(i, 3).Value * SF: Arr3Doubles(2) = xlSht.Cells(i, 4).Value * SF
                              vCenter = Arr3Doubles
                              Arr3Doubles(0) = 0: Arr3Doubles(1) = 0: Arr3Doubles(2) = 1
                              vAxis = Arr3Doubles
                              Arr3Doubles(0) = 0: Arr3Doubles(1) = 1: Arr3Doubles(2) = 0
                              vRefDir = Arr3Doubles
                                
                                'post states file contains diameter. Therefore divide by 2 in sphere creation for radius.
                              Set swSurf = swModeler.CreateSphericalSurface2(vCenter, vAxis, vRefDir, xlSht.Cells(i, 1).Value * SF / 2)
                            
                              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, 0) 'swCreateFeatureBodyCheck + swCreateFeatureBodySimplify)
                            
                              swFeat.Name = "Sphere_" & i
                              
                              If i Mod REPORTINTERVAL = 0 Then
                                  swPane.Text = "Spheres created: " & i & " (Updates every " & REPORTINTERVAL & ")"
                              End If
                              
                              If i Mod SPHERESPERFILE = 0 Then
                                  swDoc.Extension.SaveAs swApp.GetCurrentMacroPathFolder & "\Spheres" & LastSaved & "-" & i & ".sldprt", 0, 8 + 1, Nothing, Empty, Empty
                                  LastSaved = i + 1
                                  Set swDoc = Nothing
                                  swApp.CloseAllDocuments True
                                  Set swDoc = swApp.NewPart
                                  Set swPart = swDoc
                                  swDoc.Visible = False
                              End If
                              i = i + 1
                              If (DoEmAll = vbNo) And (i > NumSpheres) Then Exit Do
                          Loop
                          swDoc.Extension.SaveAs swApp.GetCurrentMacroPathFolder & "\Spheres" & LastSaved & "-" & i - 1 & ".sldprt", 0, 8 + 1, Nothing, Empty, Empty
                          Set xlSht = Nothing
                           Set xlBook = Nothing
                           xlApp.Quit
                           Set xlApp = Nothing
                           Set swPane = Nothing
                        swDoc.Visible = True
                        swDoc.ViewZoomtofit
                          MsgBox "Finished in " & Round(Timer - StopWatch, 2) & " seconds."
                        
                      End Sub
                      
                        • Re: Multiple spheres in the same file
                          Ali Moeini

                          This is awesome! I was looking for a macro like this for a long time.
                          I have a very similar model, a cube with many spheres with different diameters inside it. Is there any way to change the surfaces to solid bodies?

                           

                          Thanks,
                          Ali

                            • Re: Multiple spheres in the same file
                              Josh Brady

                              Should be possible.  Have you given it a try?  You would only need to change things in the neighborhood of lines 78~80 in my code above.

                                • Re: Multiple spheres in the same file
                                  Ali Moeini

                                  Could you please help me more? I still couldn't find a way

                                    • Re: Multiple spheres in the same file
                                      Josh Brady

                                      Easy way out:  Just run Import Diagnostics at the end.  See below:

                                       

                                      Option Explicit
                                        
                                        
                                      Const REPORTINTERVAL As Long = 10
                                      Const SPHERESPERFILE As Long = 1000
                                      Const MAKESOLIDS As Boolean = True
                                      Const XLPATH As String = "\\rmx-dc01\rmx_redirected$\jbrady\Desktop\OpenTest\partbedmrb.xlsx"
                                      Const SphereMax As Double = 0.05 '(50mm)
                                      Const SF As Double = 0.001 'multiplier to change mm to m
                                      Const BoxSize As Double = 1 ' (1m)
                                      Const NumSpheres As Long = 105
                                      Dim xlApp As Object
                                      Dim xlBook As Object
                                      Dim xlSht As Object
                                      Dim swPane As SldWorks.StatusBarPane
                                          
                                          
                                          
                                      Sub main()
                                          
                                          Dim swApp As SldWorks.SldWorks
                                          Dim swDoc As ModelDoc2
                                          Dim swBody As Body2
                                          Dim vBods As Variant
                                          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
                                          Set swPane = swApp.Frame.GetStatusBarPane
                                          
                                          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
                                          Dim DoEmAll As Long
                                          Dim LastSaved As Long
                                            
                                          'Create XL
                                          Set xlApp = CreateObject("Excel.Application")
                                          Set xlBook = xlApp.Workbooks.Open(XLPATH)
                                          Set xlSht = xlApp.ActiveSheet
                                              
                                          
                                          Randomize
                                          
                                          DoEmAll = MsgBox("Do all spheres?  Choosing ""No"" will only do first " & NumSpheres & _
                                                  vbCrLf & "Window will hide to improve performance.", vbYesNo)
                                              
                                          StopWatch = Timer
                                          i = 1
                                          swDoc.Visible = False
                                          LastSaved = 1
                                          Do While xlSht.Cells(i, 1).Value <> ""
                                              Arr3Doubles(0) = xlSht.Cells(i, 2).Value * SF: Arr3Doubles(1) = xlSht.Cells(i, 3).Value * SF: Arr3Doubles(2) = xlSht.Cells(i, 4).Value * SF
                                              vCenter = Arr3Doubles
                                              Arr3Doubles(0) = 0: Arr3Doubles(1) = 0: Arr3Doubles(2) = 1
                                              vAxis = Arr3Doubles
                                              Arr3Doubles(0) = 0: Arr3Doubles(1) = 1: Arr3Doubles(2) = 0
                                              vRefDir = Arr3Doubles
                                                  
                                                'post states file contains diameter. Therefore divide by 2 in sphere creation for radius.
                                              Set swSurf = swModeler.CreateSphericalSurface2(vCenter, vAxis, vRefDir, xlSht.Cells(i, 1).Value * SF / 2)
                                              
                                              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, 3) 'swCreateFeatureBodyCheck + swCreateFeatureBodySimplify)
                                              
                                              swFeat.Name = "Sphere_" & i
                                                
                                              If i Mod REPORTINTERVAL = 0 Then
                                                  swPane.Text = "Spheres created: " & i & " (Updates every " & REPORTINTERVAL & ")"
                                              End If
                                                
                                              If i Mod SPHERESPERFILE = 0 Then
                                                  swDoc.Extension.SaveAs swApp.GetCurrentMacroPathFolder & "\Spheres" & LastSaved & "-" & i & ".sldprt", 0, 8 + 1, Nothing, Empty, Empty
                                                  LastSaved = i + 1
                                                  Set swDoc = Nothing
                                                  swApp.CloseAllDocuments True
                                                  Set swDoc = swApp.NewPart
                                                  Set swPart = swDoc
                                                  swDoc.Visible = False
                                              End If
                                              i = i + 1
                                              If (DoEmAll = vbNo) And (i > NumSpheres) Then Exit Do
                                          Loop
                                          If MAKESOLIDS Then
                                              swDoc.ImportDiagnosis True, False, True, 0
                                          End If
                                          swDoc.Extension.SaveAs swApp.GetCurrentMacroPathFolder & "\Spheres" & LastSaved & "-" & i - 1 & ".sldprt", 0, 8 + 1, Nothing, Empty, Empty
                                          Set xlSht = Nothing
                                           Set xlBook = Nothing
                                           xlApp.Quit
                                           Set xlApp = Nothing
                                           Set swPane = Nothing
                                        swDoc.Visible = True
                                        swDoc.ViewZoomtofit
                                          MsgBox "Finished in " & Round(Timer - StopWatch, 2) & " seconds."
                                          
                                      End Sub
                                      
                          • Re: Multiple spheres in the same file
                            Ali Moeini

                            I am not experienced in VBA coding. I tried using ICreateBodyFromSheets2 command but couldn't apply it correctly.