VB.Net 返回 CAD 多段线的 截面形心
https://www.theswamp.org/index.php?topic=25741.0
程序代码: | [ 复制代码到剪贴板 ] |
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()
&n
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()
&n