FIllet Two Members Through VBA

[andrewk15]

I need to fillet two lines with a specified radius using VBA. I have not been able to find anything on this subject using VBA. Any help is greatly appreciated.

[fixo · Accepted solution]

Here you go, just change fillet radius on whatever you want

Attribute VB_Name = "modFilletLines"
Option Explicit

Sub LineFillet()
Dim setName As String
Dim setObj As AcadSelectionSet


    setName = "$Lines$"
    On Error GoTo Err_Control

            Dim fType(0) As Integer, fData(0)
            Dim oSset As AcadSelectionSet

     fType(0) = 0: fData(0) = "LINE"
  
     Dim dxfcode As Variant
     Dim dxfdata As Variant
     dxfcode = fType: dxfdata = fData
     
     Dim setColl As AcadSelectionSets
     With ThisDrawing
          Set setColl = .SelectionSets
          For Each setObj In setColl
               If setObj.Name = setName Then
                    .SelectionSets.Item(setName).Delete
                    Exit For
               End If
          Next
          Set oSset = .SelectionSets.Add(setName)
     End With

            oSset.SelectOnScreen dxfcode, dxfdata
            
            If oSset.Count <> 2 Then
            MsgBox "Select 2 lines only"
            Exit Sub
            End If
            Dim lnf As AcadLine
                    Dim lns As AcadLine
              Set lnf = oSset.Item(0)
              Set lns = oSset.Item(1)
           Dim hdlf As String: hdlf = lnf.Handle
           Dim hdls As String: hdls = lns.Handle
           Dim filrad As Double
           filrad = ThisDrawing.GetVariable("filletrad")
           ThisDrawing.SetVariable "filletrad", 25#
           ThisDrawing.SetVariable "cmdecho", 1
           Dim cmd As String
           cmd = "(command " & Chr(34) & "_.fillet" & Chr(34) & " (handent " & Chr(34) & hdlf & Chr(34) & ")" & Chr(32) & "(handent " & Chr(34) & hdls & Chr(34) & ")" & Chr(32) & Chr(34) & Chr(34) & Chr(32) & Chr(34) & Chr(34) & ")" & vbCr
           ThisDrawing.SendCommand (cmd)
           
Err_Control:
           If Err.Number <> 0 Then
           MsgBox Err.Description
           End If
           
End Sub

[andrewk15]

Thanks. This is perfect.

[fixo]

You're welcome 🙂

[jeremye86]

should we put an API sleep routine after this line in case autocad gets hung up?

ThisDrawing.SendCommand (cmd)