I wrote this code (with help from reading other peoples posted code) and it seems to work but sometimes the Arc is counterclockwise and other times clockwise.
maybe one of you could tell me were i went wrong with what part of my code.
Imports System
Imports System.Runtime.InteropServices
Imports Autodesk.AutoCAD
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.LayerManager
Imports Autodesk.AutoCAD.Windows
Imports Autodesk.AutoCAD.ApplicationServices.Application
Imports Autodesk.AutoCAD.PlottingServices
Namespace AutoCAD_VB_plug_in1
Public Class MyCommands
<CommandMethod("Test", CommandFlags.UsePickSet + CommandFlags.Session)> _
Public Sub TestFillet()
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Using acLckDocCur As DocumentLock = doc.LockDocument
Using tr As Transaction = db.TransactionManager.StartTransaction()
Try
Dim Line1ID As ObjectId = PickEntity()
Dim ent1 As Entity = tr.GetObject(Line1ID, OpenMode.ForRead)
Dim Newline1 As Line = TryCast(ent1, Line)
Dim Line2ID As ObjectId = PickEntity()
Dim ent2 As Entity = tr.GetObject(Line2ID, OpenMode.ForRead)
Dim Newline2 As Line = TryCast(ent2, Line)
Dim Rad As Double = GetDouble("Enter Fillet Radius")
Dim MYFillet As List(Of Object) = AddFillet(db, Newline1, Newline2, Rad)
If MYFillet.Item(0) = True Then
Dim ConLine1 As Geometry.LineSegment3d = MYFillet.Item(1)
Dim ConLine2 As Geometry.LineSegment3d = MYFillet.Item(2)
Dim ConArc3d As Geometry.CircularArc3d = MYFillet.Item(3)
Dim MyMatrix3d As Matrix3d = MYFillet.Item(4)
'sometimes the arc is counterclockwise other times clockwise
Dim arc As Arc = New Arc(ConArc3d.Center, ConArc3d.Radius, ConArc3d.StartAngle, ConArc3d.EndAngle)
arc.TransformBy(MyMatrix3d)
Newline1.UpgradeOpen()
Newline1.StartPoint = ConLine1.StartPoint
Newline1.EndPoint = ConLine1.EndPoint
Newline2.UpgradeOpen()
Newline2.StartPoint = ConLine2.StartPoint
Newline2.EndPoint = ConLine2.EndPoint
AddToCurrentSpace(db, arc)
Else
ShowAlertDialog(MYFillet.Item(1).ToString)
End If
tr.Commit()
Catch ex As Autodesk.AutoCAD.Runtime.Exception
End Try
End Using
End Using
End Sub
'credit to Hallex one of his post was really helpful
Private Function AddFillet(ByVal MyDB As Database, ByVal Line1 As Line, ByVal Line2 As Line, ByVal Radius As Double) As List(Of Object)
Dim DicOBJS As List(Of Object) = New List(Of Object)
Dim bFlipLine1 As Boolean = False
Dim bFlipLine2 As Boolean = False
Try
Dim intpts As New Point3dCollection()
Line1.IntersectWith(Line2, Intersect.ExtendBoth, intpts, IntPtr.Zero, IntPtr.Zero)
If intpts.Count <> 1 Then
DicOBJS.Add(False)
DicOBJS.Add("Lines are colinear or does not intersects")
Return DicOBJS
End If
Dim IntPoint As Point3d = intpts(0)
Dim Line1SP As Point3d = IntPoint
Dim Line1EP As Point3d
Dim Line2SP As Point3d = IntPoint
Dim Line2EP As Point3d
If IntPoint.DistanceTo(Line1.StartPoint) >= IntPoint.DistanceTo(Line1.EndPoint) Then
Line1EP = Line1.StartPoint
bFlipLine1 = True
Else
Line1EP = Line1.EndPoint
End If
If IntPoint.DistanceTo(Line2.StartPoint) >= IntPoint.DistanceTo(Line2.EndPoint) Then
Line2EP = Line2.StartPoint
bFlipLine2 = True
Else
Line2EP = Line2.EndPoint
End If
Dim MyMatrix3d As Matrix3d = UCS_Create(IntPoint, Line1EP, Line2EP)
'Transform points to new Matrix3d
Dim Newip As Point3d = IntPoint.TransformBy(MyMatrix3d.Inverse)
Dim SP1 As Point3d = Line1SP.TransformBy(MyMatrix3d.Inverse)
Dim EP1 As Point3d = Line1EP.TransformBy(MyMatrix3d.Inverse)
Dim SP2 As Point3d = Line2SP.TransformBy(MyMatrix3d.Inverse)
Dim EP2 As Point3d = Line2EP.TransformBy(MyMatrix3d.Inverse)
'calculate angle of lines
Dim ang1 As Double = AngleFromX(Newip, EP1)
Dim ang2 As Double = AngleFromX(Newip, EP2)
'calculate angle between lines
Dim angc As Double = Math.Abs(ang2 - ang1)
'Get Distance to Tangent along Lines
Dim DistTOTangent As Double = (Radius + (Radius * Math.Cos(angc))) / Math.Sin(angc)
'Move Start Point of Lines to The Tangent Point
SP1 = PolarPoint3D(Newip, ang1, DistTOTangent)
SP2 = PolarPoint3D(Newip, ang2, DistTOTangent)
If Newip.DistanceTo(EP1) < DistTOTangent Then
DicOBJS.Add(False)
DicOBJS.Add("Radius to Large")
Return DicOBJS
End If
If Newip.DistanceTo(EP2) < DistTOTangent Then
DicOBJS.Add(False)
DicOBJS.Add("Radius to Large")
Return DicOBJS
End If
Dim ArcCenterPoint As Point3d = PolarPoint3D(Newip, angc * 0.5, Math.Sqrt((DistTOTangent * DistTOTangent) + (Radius * Radius)))
Dim ArcStartAngle As Double
Dim ArcEndAngle As Double
' check on direction of points
If isLeft(EP2, Newip, EP1) Then
ArcStartAngle = AngleFromX(ArcCenterPoint, SP2)
ArcEndAngle = AngleFromX(ArcCenterPoint, SP1)
Else
ArcStartAngle = AngleFromX(ArcCenterPoint, SP1)
ArcEndAngle = AngleFromX(ArcCenterPoint, SP2)
End If
If bFlipLine1 = True Then
Dim TempSP1 As Point3d = SP1
SP1 = EP1
EP1 = TempSP1
End If
If bFlipLine2 = True Then
Dim TempSP2 As Point3d = SP2
SP2 = EP2
EP2 = TempSP2
End If
Dim ConArc3d As Geometry.CircularArc3d = New Geometry.CircularArc3d(ArcCenterPoint, Vector3d.ZAxis, Vector3d.ZAxis, Radius, ArcStartAngle, ArcEndAngle)
Dim ConLine1 As Geometry.LineSegment3d = New Geometry.LineSegment3d(SP1.TransformBy(MyMatrix3d), EP1.TransformBy(MyMatrix3d))
Dim ConLine2 As Geometry.LineSegment3d = New Geometry.LineSegment3d(SP2.TransformBy(MyMatrix3d), EP2.TransformBy(MyMatrix3d))
DicOBJS.Add(True)
DicOBJS.Add(ConLine1)
DicOBJS.Add(ConLine2)
DicOBJS.Add(ConArc3d)
DicOBJS.Add(MyMatrix3d)
Return DicOBJS
Catch ex As Autodesk.AutoCAD.Runtime.Exception
DicOBJS.Add(False)
DicOBJS.Add("UnKnown Error")
Return DicOBJS
End Try
End Function
Private Function PickEntity() As ObjectId
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Dim peo As PromptEntityOptions = New PromptEntityOptions("\nSelect AutoCad Entity :")
Dim per As PromptEntityResult = ed.GetEntity(peo)
If (per.Status = PromptStatus.OK) Then
Return per.ObjectId
Else
Return ObjectId.Null
End If
End Function
Private Function GetDouble(ByVal sPrompt As String, Optional ByVal AllowNegative As Boolean = False, Optional ByVal AllowNone As Boolean = False, Optional ByVal AllowZero As Boolean = False, Optional ByVal DefaultValue As Double = 0, Optional ByVal UseDefaultValue As Boolean = False) As Double
Dim DwgEditor As Editor = DocumentManager.MdiActiveDocument.Editor
Dim myPDO As New PromptDoubleOptions(sPrompt)
Try
myPDO.AllowNegative = AllowNegative
myPDO.AllowNone = AllowNone
myPDO.AllowZero = AllowZero
myPDO.DefaultValue = DefaultValue
myPDO.UseDefaultValue = UseDefaultValue
Dim myPDR As PromptDoubleResult = DwgEditor.GetDouble(myPDO)
DwgEditor.WriteMessage(vbCrLf)
Select Case myPDR.Status
Case PromptStatus.OK
Return myPDR.Value
Case PromptStatus.Cancel
Return 0
End Select
Catch
Return 0
End Try
End Function
Private Function AddToCurrentSpace(ByVal MyDB As Database, ByVal EntityIn As Entity) As DatabaseServices.ObjectId
Dim DwgEditor As Editor = TryCast(Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor, Editor)
Using myTrans As Transaction = MyDB.TransactionManager.StartTransaction
Try
Dim myBT As BlockTable = TryCast(MyDB.BlockTableId.GetObject(OpenMode.ForRead), BlockTable)
Dim myCurrentSpace As BlockTableRecord = TryCast(myBT.Database.CurrentSpaceId.GetObject(OpenMode.ForWrite), BlockTableRecord)
myCurrentSpace.AppendEntity(EntityIn)
myTrans.AddNewlyCreatedDBObject(EntityIn, True)
myTrans.Commit()
Return EntityIn.ObjectId
Catch ex As Autodesk.AutoCAD.Runtime.Exception
DwgEditor.WriteMessage(ex.Message + vbLf + ex.StackTrace)
myTrans.Abort()
Return ObjectId.Null
End Try
End Using
End Function
Private Function UCS_Create(ByVal OriginPoint As Point3d, ByVal XAxisPoint As Point3d, ByVal YAxisPoint As Point3d) As Matrix3d
Dim xAxis As Vector3d
Dim yAxis As Vector3d
Dim ZAxis As Vector3d
If OriginPoint.IsEqualTo(XAxisPoint) Or OriginPoint.IsEqualTo(YAxisPoint) Or XAxisPoint.IsEqualTo(YAxisPoint) Then
Return Nothing
End If
Try
xAxis = OriginPoint.GetVectorTo(XAxisPoint).GetNormal
ZAxis = xAxis.CrossProduct(YAxisPoint.GetVectorTo(OriginPoint).GetNormal).GetNormal
yAxis = xAxis.CrossProduct(ZAxis).GetNormal
Dim NewMatrix3d As Matrix3d = Matrix3d.AlignCoordinateSystem(Point3d.Origin, Vector3d.XAxis, Vector3d.YAxis, Vector3d.ZAxis, OriginPoint, xAxis, yAxis, ZAxis)
Return NewMatrix3d
Catch
Return Nothing
End Try
End Function
Private Function PolarPoint3D(ByVal BasePoint As Point3d, ByVal angle As Double, ByVal distance As Double) As Point3d
Dim x As Double = distance * Math.Cos(angle)
Dim y As Double = distance * Math.Sin(angle)
Return New Point3d(BasePoint.X + x, BasePoint.Y + y, BasePoint.Z)
End Function
'''author Unknown
Private Function AngleFromX(ByVal pt1 As Point3d, ByVal pt2 As Point3d) As Double
Dim ucsplane As New Plane(New Point3d(0, 0, 0), New Vector3d(0, 0, 1))
Dim vec As Vector3d = pt2 - pt1
Dim ang As Double = vec.AngleOnPlane(ucsplane)
If ang * 180 / Math.PI = 360 Then
ang = 0
End If
Return ang
End Function
'''isleft function (edited) // credit to Bryco
Private Function isLeft(ByVal spt As Point3d, ByVal ept As Point3d, ByVal apt As Point3d) As Boolean
Dim result As Boolean = False
Dim Ans As Double = ((ept.X - spt.X) * (apt.Y - spt.Y) - (apt.X - spt.X) * (ept.Y - spt.Y))
If Ans > 0 Then
result = True
Else
result = False
End If
Return result
End Function
End Class
End Namespace
