Imports System
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime

Namespace PolylineCentroid
    ' Main class
    Public Class Centroid
        Public Function GetCentroid(ByVal pl As Polyline) As Point3d
            Dim p0 As Point2d = pl.GetPoint2dAt(0)
            Dim cen As New Point2d(0.0, 0.0)
            Dim area As Double = 0.0
            Dim bulge As Double = pl.GetBulgeAt(0)
            Dim last As Integer = pl.NumberOfVertices - 1
            Dim tmpArea As Double
            Dim tmpPoint As Point2d

            If bulge <> 0.0 Then
                Dim datas As Double() = getArcGeom(pl, bulge, 0, 1)
                area = datas(0)
                cen = New Point2d(datas(1), datas(2)) * datas(0)
            End If
            Dim i As Integer = 1
            While i < last
                tmpArea = triangleAlgebricArea(p0, pl.GetPoint2dAt(i), pl.GetPoint2dAt(i + 1))
                tmpPoint = triangleCentroid(p0, pl.GetPoint2dAt(i), pl.GetPoint2dAt(i + 1))
                cen += (tmpPoint * tmpArea).GetAsVector()
                area += tmpArea
                bulge = pl.GetBulgeAt(i)
                If bulge <> 0.0 Then
                    Dim datas As Double() = getArcGeom(pl, bulge, i, i + 1)
                    area += datas(0)
                    cen += New Vector2d(datas(1), datas(2)) * datas(0)
                End If
                System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
            End While
            bulge = pl.GetBulgeAt(last)
            If bulge <> 0.0 Then
                Dim datas As Double() = getArcGeom(pl, bulge, last, 0)
                area += datas(0)
                cen += New Vector2d(datas(1), datas(2)) * datas(0)
            End If
            cen = cen.DivideBy(area)
            Dim result As New Point3d(cen.X, cen.Y, pl.Elevation)
            Return result.TransformBy(Matrix3d.PlaneToWorld(pl.Normal))
        End Function


        Public Function GetArcGeom(ByVal pl As Polyline, ByVal bulge As Double, ByVal index1 As Integer, ByVal index2 As Integer) As Double()
            Dim arc As CircularArc2d = (pl.GetArcSegment2dAt(index1))
            Dim arcRadius As Double = arc.Radius
            Dim arcCenter As Point2d = arc.Center
            Dim arcAngle As Double = 4.0 * Math.Atan(bulge)
            Dim tmpArea As Double = arcAlgebricArea(arcRadius, arcAngle)
            Dim tmpPoint As Point2d = ArcCentroid(pl.GetPoint2dAt(index1), pl.GetPoint2dAt(index2), arcCenter, tmpArea)
            Dim D As Double() = Nothing
            D.SetValue(tmpArea, 0)
            D.SetValue(tmpPoint.X, 1)
            D.SetValue(tmpPoint.Y, 2)
            Return D
        End Function


        Public Function TriangleCentroid(ByVal p0 As Point2d, ByVal p1 As Point2d, ByVal p2 As Point2d) As Point2d
            Return (p0 + p1.GetAsVector() + p2.GetAsVector()) / 3.0
        End Function


        Public Function TriangleAlgebricArea(ByVal p0 As Point2d, ByVal p1 As Point2d, ByVal p2 As Point2d) As Double
            Return (((p1.X - p0.X) * (p2.Y - p0.Y)) - ((p2.X - p0.X) * (p1.Y - p0.Y))) / 2.0
        End Function


        Public Function ArcCentroid(ByVal start As Point2d, ByVal [end] As Point2d, ByVal cen As Point2d, ByVal tmpArea As Double) As Point2d
            Dim chord As Double = start.GetDistanceTo([end])
            Dim angle As Double = angleFromTo(start, [end])
            Return polar2d(cen, angle - (Math.PI / 2.0), (chord * chord * chord) / (12.0 * tmpArea))
        End Function


        Public Function ArcAlgebricArea(ByVal rad As Double, ByVal ang As Double) As Double
            Return rad * rad * (ang - Math.Sin(ang)) / 2.0
        End Function


        Public Function AngleFromTo(ByVal p1 As Point2d, ByVal p2 As Point2d) As Double
            Return (p2 - p1).Angle
        End Function


        Public Function Polar2d(ByVal org As Point2d, ByVal angle As Double, ByVal distance As Double) As Point2d
            Return New Point2d(org.X + distance, org.Y).RotateBy(angle, org)
        End Function


    End Class

    ' Testing command
    Public Class [MyClass]
        <CommandMethod("pline_centroid")> _
        Public Sub centroid()
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor

            Dim opts As New PromptEntityOptions(vbLf & "Select a polyline: ")
            opts.AllowNone = True
            opts.AllowObjectOnLockedLayer = True
            opts.SetRejectMessage(vbLf & "Entité non valide.")
            opts.AddAllowedClass(GetType(Polyline), False)
            Dim pline As PromptEntityResult = ed.GetEntity(opts)
            If pline.Status = PromptStatus.OK Then
                Dim ObjID As ObjectId = pline.ObjectId
                Try
                    Using trans As Transaction = db.TransactionManager.StartTransaction()
                        Dim ent As Polyline = CType(trans.GetObject(ObjID, OpenMode.ForRead, False), Polyline)
                        Dim c As New Centroid()
                        Dim cen As Point3d = c.GetCentroid(ent)
                        Dim pt As New DBPoint(cen)
                        Dim bTable As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
                        Dim mSpace As BlockTableRecord = CType(trans.GetObject(bTable(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                        mSpace.AppendEntity(pt)
                        trans.AddNewlyCreatedDBObject(pt, True)
                        trans.Commit()
                    End Using
                Catch ex As System.Exception
                    ed.WriteMessage("Error: " + ex.Message)
                End Try
            End If
        End Sub


    End Class

    ' LISP function
    Public Class LispCentoid
        <LispFunction("pline_centroid")> _
        Public Shared Function centroid(ByVal buff As ResultBuffer) As Object
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor

            If buff Is Nothing Then
                ed.WriteMessage("Error: none argument." & vbLf)
                Return False
            End If

            Dim args As TypedValue() = buff.AsArray()
            If args(0).TypeCode <> CType(LispDataType.ObjectId, Integer) Then
                ed.WriteMessage("Error: incorrect argument type: lentityp {0}." & vbLf, args(0).Value)
                Return False
            End If
            Dim objID As ObjectId = CType(args(0).Value, ObjectId)
            Try
                Using trans As Transaction = db.TransactionManager.StartTransaction()
                    Dim ent As Entity = CType(trans.GetObject(objID, OpenMode.ForRead, False), Entity)
                    Dim entType As String = ent.[GetType]().ToString().Substring(34)
                    If entType = "Polyline" Then
                        Dim pl As Polyline = CType(trans.GetObject(objID, OpenMode.ForRead, False), Polyline)
                        Dim c As New Centroid()
                        Return c.GetCentroid(pl)
                    Else
                        If entType.Contains("DB") Then
                            entType = entType.Substring(2)
                        End If
                        ed.WriteMessage("Error: incorrect entity type: " + entType + vbLf)
                        Return Nothing
                    End If
                End Using
            Catch ex As System.Exception
                ed.WriteMessage(vbLf & "Error: " + ex.Message + vbLf)
                Return False
            End Try
        End Function


    End Class
End Namespace