4 Replies Latest reply on Oct 31, 2014 12:21 AM by Pranjal Jamsandekar

    How do I write the macro for continous fillet as in the attached image ?

    Pranjal Jamsandekar

      Dim swApp As SldWorks.SldWorks
      Dim swModel As SldWorks.ModelDoc2
      Dim swSketchMgr As SldWorks.SketchManager
      Dim swSketchSeg As SldWorks.SketchSegment
      Dim swLine(31) As SldWorks.SketchLine


      Sub main()
          Set swApp = Application.SldWorks
          Set swModel = swApp.ActiveDoc
          Set swSketchMgr = swModel.SketchManager
         
          'create plane and insert the sketch
          swModel.Extension.SelectByID2 "TOP PLANE", "PLANE", 0, 0, 0, False, 0, Nothing, 0
          swSketchMgr.InsertSketch True
         
          'turn on direct addition to database
          swSketchMgr.AddToDB = True
         
          'create first logo
           Set swLine(0) = swSketchMgr.CreateLine(0.2065, 0.02, 0, 0.1885, 0.02, 0)
           Set swLine(1) = swSketchMgr.CreateLine(0.1885, 0.02, 0, 0.1885, -0.02, 0)
           Set swLine(2) = swSketchMgr.CreateLine(0.1885, -0.02, 0, 0.2065, -0.02, 0)
           Set swLine(3) = swSketchMgr.CreateLine(0.2065, -0.02, 0, 0.2065, 0.02, 0)
         
         'create second logo
          Set swLine(4) = swSketchMgr.CreateLine(0.1415, 0.02, 0, 0.1235, 0.02, 0)
          Set swLine(5) = swSketchMgr.CreateLine(0.1235, 0.02, 0, 0.1235, -0.02, 0)
          Set swLine(6) = swSketchMgr.CreateLine(0.1235, -0.02, 0, 0.1415, -0.02, 0)
          Set swLine(7) = swSketchMgr.CreateLine(0.1415, -0.02, 0, 0.1415, 0.02, 0)
        
         'create third logo
          Set swLine(8) = swSketchMgr.CreateLine(0.0915, 0.02, 0, 0.0735, 0.02, 0)
          Set swLine(9) = swSketchMgr.CreateLine(0.0735, 0.02, 0, 0.0735, -0.02, 0)
          Set swLine(10) = swSketchMgr.CreateLine(0.0735, -0.02, 0, 0.0915, -0.02, 0)
          Set swLine(11) = swSketchMgr.CreateLine(0.0915, -0.02, 0, 0.0915, 0.02, 0)
          
         'create fourth logo
          Set swLine(12) = swSketchMgr.CreateLine(0.0415, 0.02, 0, 0.0235, 0.02, 0)
          Set swLine(13) = swSketchMgr.CreateLine(0.0235, 0.02, 0, 0.0235, -0.02, 0)
          Set swLine(14) = swSketchMgr.CreateLine(0.0235, -0.02, 0, 0.0415, -0.02, 0)
          Set swLine(15) = swSketchMgr.CreateLine(0.0415, -0.02, 0, 0.0415, 0.02, 0)

       

        'create corner fillet
        Dim i As Integer
       
         For i = 0 To UBound(swLine)
              Set swSketchSeg = swLine(i)
              swSketchSeg.Select False
             
              If i = UBound(swLine) Then
                  Set swSketchSeg = swLine(0)
              Else
                  Set swSketchSeg = swLine(i + 1)
                             
              End If
                   
              swSketchSeg.Select True
              Set swSketchSeg = swSketchMgr.CreateFillet(0.006, 1)
          Next i
         
       
           'turn off direct addition to database
          swSketchMgr.AddToDB = False
      End Sub

       

       

       

       

      Rectangle Shape.JPG

       

       

      Could anybody please help me to get the fillet continuous as in attached image.

        • Re: How do I write the macro for continous fillet as in the attached image ?
          Daniel Andersson

          I would differentiate each profile by extending the array (to multidimensional) or put each profile in a collection.

           

          If you use that profile often and repetitive, I would suggest that you make a class (object) of it. The objects could also be in a collection to keep them together. There is also further benefits to use classes (objects). Since you can create your own methods and properties for each profile (width, height, radius, etc.)

            • Re: How do I write the macro for continous fillet as in the attached image ?
              Pranjal Jamsandekar

              Thanks for the reply.

               

              I will check the method you have explained above.

                • Re: How do I write the macro for continous fillet as in the attached image ?
                  Daniel Andersson

                  Perhaps you already got this going, but I had a few minutes to night to give you this example of using multi-dimensional array.

                   

                  Except from the code below, I would like to tell you a test I did. If you want to increase performance of the code, use swSketchMgr.DisplayWhenAdded = False / True.

                  Please pay attention to the Remarks of this property!

                   

                  Measured the performance difference and got this result:

                  Macro process time [s]: 0.765 (Enabled DisplayWhenAdded)

                  Macro process time [s]: 0.889 (Current code)

                   

                  So there is definitely time to cut here if you have more sketch entities to be added.

                   

                   

                  Dim swApp As SldWorks.SldWorks
                  Dim swModel As SldWorks.ModelDoc2
                  Dim swSketchMgr As SldWorks.SketchManager
                  Dim swSketchSeg As SldWorks.SketchSegment
                  Dim swLine(3, 3) As SldWorks.SketchLine

                  Sub main()
                      Set swApp = Application.SldWorks
                      Set swModel = swApp.ActiveDoc
                      Set swSketchMgr = swModel.SketchManager
                     
                      'create plane and insert the sketch
                      swModel.Extension.SelectByID2 "TOP PLANE", "PLANE", 0, 0, 0, False, 0, Nothing, 0
                      swSketchMgr.InsertSketch True
                     
                      'turn on direct addition to database
                      swSketchMgr.AddToDB = True
                     
                      'create first logo
                       Set swLine(0, 0) = swSketchMgr.CreateLine(0.2065, 0.02, 0, 0.1885, 0.02, 0)
                       Set swLine(0, 1) = swSketchMgr.CreateLine(0.1885, 0.02, 0, 0.1885, -0.02, 0)
                       Set swLine(0, 2) = swSketchMgr.CreateLine(0.1885, -0.02, 0, 0.2065, -0.02, 0)
                       Set swLine(0, 3) = swSketchMgr.CreateLine(0.2065, -0.02, 0, 0.2065, 0.02, 0)
                     
                     'create second logo
                      Set swLine(1, 0) = swSketchMgr.CreateLine(0.1415, 0.02, 0, 0.1235, 0.02, 0)
                      Set swLine(1, 1) = swSketchMgr.CreateLine(0.1235, 0.02, 0, 0.1235, -0.02, 0)
                      Set swLine(1, 2) = swSketchMgr.CreateLine(0.1235, -0.02, 0, 0.1415, -0.02, 0)
                      Set swLine(1, 3) = swSketchMgr.CreateLine(0.1415, -0.02, 0, 0.1415, 0.02, 0)
                    
                     'create third logo
                      Set swLine(2, 0) = swSketchMgr.CreateLine(0.0915, 0.02, 0, 0.0735, 0.02, 0)
                      Set swLine(2, 1) = swSketchMgr.CreateLine(0.0735, 0.02, 0, 0.0735, -0.02, 0)
                      Set swLine(2, 2) = swSketchMgr.CreateLine(0.0735, -0.02, 0, 0.0915, -0.02, 0)
                      Set swLine(2, 3) = swSketchMgr.CreateLine(0.0915, -0.02, 0, 0.0915, 0.02, 0)
                      
                     'create fourth logo
                      Set swLine(3, 0) = swSketchMgr.CreateLine(0.0415, 0.02, 0, 0.0235, 0.02, 0)
                      Set swLine(3, 1) = swSketchMgr.CreateLine(0.0235, 0.02, 0, 0.0235, -0.02, 0)
                      Set swLine(3, 2) = swSketchMgr.CreateLine(0.0235, -0.02, 0, 0.0415, -0.02, 0)
                      Set swLine(3, 3) = swSketchMgr.CreateLine(0.0415, -0.02, 0, 0.0415, 0.02, 0)

                  'create corner fillet
                    Dim i As Integer

                  For k = 0 To UBound(swLine, 1)
                       For i = 0 To UBound(swLine, 2)
                          Set swSketchSeg = swLine(k, i)
                          swSketchSeg.Select False

                          If i = UBound(swLine, 2) Then
                              Set swSketchSeg = swLine(k, 0)
                          Else
                              Set swSketchSeg = swLine(k, i + 1)

                          End If

                          swSketchSeg.Select True
                          Set swSketchSeg = swSketchMgr.CreateFillet(0.006, 1)
                      Next
                  Next

                       'turn off direct addition to database
                      swSketchMgr.AddToDB = False
                  End Sub