AnsweredAssumed Answered

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

Question asked by Pranjal Jamsandekar on Oct 28, 2014
Latest reply on Oct 31, 2014 by 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.

Outcomes