田草博客
日志搜索


 标题   内容 评论


网友交流QQ群:11740834 需注明申请加入原因

微信 公众号:ByCAD

邮箱:tiancao1001x126.com
ByCAD,微信公众号
首页 | 普通 | 电脑 | AutoCAD | VB/VB.NET | FLash | 结构 | 建筑 | 电影 | BIM | 规范 | 软件
-电信用户-|-网通用户-
-博客论坛-|-软件下载-
-网站导航-|-规范下载-
-BelovedFLash欣赏-

用户登陆
用户:
密码:
 

站点日历
73 2020 - 6 48
 123456
78910111213
14151617181920
21222324252627
282930


站点统计

最新评论



AUTOCAD 选择对像后触发事件 在64位Windows7 上安装32位AutoCAD
未知 VB.Net 返回 CAD 多段线的 截面形心   [ 日期:2016-12-25 ]   [ 来自:本站原创 ]  HTML
VB.Net Getting the centroid of  polyline

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