Cad.Net 重构折线bo函数

由于CAD自带Bo函数,在二次开发时无论使用SendCommand方式,还是TraceBoundary函数,其精度都与视口大小挂钩。测试代码如下:

    '测试cad自带bo命令功能
    <CommandMethod("bot1")>
    Public Sub botest()
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Dim acDocEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
            Dim acSSPrompt As PromptSelectionResult
            acSSPrompt = acDocEd.GetSelection()
            Dim acSSet = acSSPrompt.Value
            Dim acpoint = acDocEd.GetPoint("请选择bo点")
            Dim point = acpoint.Value
            acDocEd.Command("-boundary", "_A", "_B", "_N", acSSet, "", "_O", "_P", "", point, "")
            acTrans.Commit()
        End Using
    End Sub

若图面精准,可通过每次使用bo命令时调整视口范围至需要获取封闭线的区域来实现精度的最大化。即利用acDocEd.GetCurrentView(),acDocEd.SetCurrentView()进行不断的视口调整。

但该方法并不优雅,会导致视口的疯狂乱窜。且当要处理手绘图,封闭线存在小缺口,需要设置一定容差时,利用原生bo功能容易出现错误,导致找漏、找错封闭区域的状况。因此,可以编写单纯通过遍历几何图形寻找bo的函数。本文参考了惊惊大佬cad.net bo边界算法的相关思路,对纯折线情况下寻找封闭区域的算法进行了vb.net的实现,方法如下:

'Entlist为图元构成的集合,bopoint为bo点,tk_max_x是射线法在虚拟射线的最右点,
'可以取消该参数,并通过设置一个极大值的方式进行代替
Public Shared Function boundary(Entlist As ArrayList, bopoint As Point3d, tk_max_x As Double) As Polyline
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Dim acDocEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim FinalBoPline = New Polyline()
        Dim NotTrueLine = New Line(bopoint, New Point3d(tk_max_x, bopoint.Y, 0))
        Dim cross_dictionary = New Dictionary(Of ObjectId, Dictionary(Of Double, ObjectId))
        Dim Linelist = New ArrayList
        Using acTrans1 As Transaction = acCurDb.TransactionManager.StartTransaction()
            'BlkInt2实现包括自交点在内所有交点全部打断
            Linelist = BlkInt2(Entlist, acTrans1)
            '构造相交矩阵,使行索引线起点与列索引线相交时,值为0,终点相交时,值为1,不相交时,值为2.
            Dim cross_arr = New ArrayList()
            For CrNum1 = 0 To Linelist.Count - 1
                Dim temp_arr = New ArrayList()
                For CrNum2 = 0 To Linelist.Count - 1
                    temp_arr.Add(2)
                Next
                cross_arr.Add(temp_arr)
            Next
            Dim k1 = 0
            For Each ent As Curve In Linelist
                Dim k2 = 0
                For Each ent1 As Curve In Linelist
                    If k1 < k2 Then
                        If Math.Abs(ent.StartPoint.DistanceTo(ent1.StartPoint)) <= 0.5 Then
                            cross_arr.Item(k1).Item(k2) = 0
                            cross_arr.Item(k2).Item(k1) = 0
                        ElseIf Math.Abs(ent.StartPoint.DistanceTo(ent1.EndPoint)) <= 0.5 Then
                            cross_arr.Item(k1).Item(k2) = 0
                            cross_arr.Item(k2).Item(k1) = 1
                        ElseIf Math.Abs(ent.EndPoint.DistanceTo(ent1.StartPoint)) <= 0.5 Then
                            cross_arr.Item(k1).Item(k2) = 1
                            cross_arr.Item(k2).Item(k1) = 0
                        ElseIf Math.Abs(ent.EndPoint.DistanceTo(ent1.EndPoint)) <= 0.5 Then
                            cross_arr.Item(k1).Item(k2) = 1
                            cross_arr.Item(k2).Item(k1) = 1
                        End If
                    End If
                    k2 = k2 + 1
                Next
                k1 = k1 + 1
            Next
            '获取备选起点集
            Dim temp_list = New Point3dCollection()
            Dim Start_dic = New Dictionary(Of Integer, Double)
            Dim virtualline As Line = New Line(New Point3d(tk_max_x, bopoint.Y, 0), bopoint)
            Dim objectindexlist = New ArrayList()
            Dim k3 = 0
            For Each ent As Curve In Linelist
                objectindexlist.Add(k3)
                virtualline.IntersectWith(ent, Intersect.OnBothOperands, temp_list, 0, 0)
                If temp_list.Count > 0 Then
                    Dim temp_dist As Double = bopoint.DistanceTo(temp_list.Item(0))
                    Start_dic.Add(k3, temp_dist)
                    temp_list = New Point3dCollection()
                End If
                k3 = k3 + 1
            Next
            Dim sorted = From pair In Start_dic
                         Order By pair.Value
            Dim sorted_dic = sorted.ToDictionary(Function(p) p.Key, Function(p) p.Value)
            '起点集获取完成,进行闭环搜索,采用深度优先搜索方式
            Dim bopointlist = New ArrayList()
            Dim indexlist = New ArrayList()
            Dim point_mark As Integer
            Dim FisrtPoint = New Point3d()
SearchFirstPoint:
            While sorted_dic.Count > 0
                Dim currentindex = objectindexlist.IndexOf(sorted_dic.First.Key)
                Dim currentline As Line
                sorted_dic.Remove(sorted_dic.First.Key)
                indexlist.Add(currentindex)
                Dim End_angle = lineangle(virtualline, New Line(Linelist.Item(currentindex).StartPoint, Linelist.Item(currentindex).EndPoint))
                Dim Start_angle = lineangle(virtualline, New Line(Linelist.Item(currentindex).EndPoint, Linelist.Item(currentindex).StartPoint))
                If Start_angle > End_angle Then
                    FisrtPoint = Linelist.Item(currentindex).StartPoint
                    bopointlist.Add(FisrtPoint)
                    currentline = New Line(Linelist.Item(currentindex).StartPoint, Linelist.Item(currentindex).EndPoint)
                    point_mark = 0
                Else
                    FisrtPoint = Linelist.Item(currentindex).EndPoint
                    bopointlist.Add(FisrtPoint)
                    currentline = New Line(Linelist.Item(currentindex).EndPoint, Linelist.Item(currentindex).StartPoint)
                    point_mark = 1
                End If
SearchPoint:
                While True
                    Dim temp_arr As ArrayList = cross_arr.Item(currentindex)
                    Dim NextMark = point_mark
                    If point_mark > 1 Then
                        GoTo Finished
                    End If
                    If Not temp_arr.Contains(point_mark) Then
                        bopointlist.RemoveAt(bopointlist.Count - 1)
                        indexlist.RemoveAt(indexlist.Count - 1)
                        If indexlist.Count < 1 Then
                            GoTo SearchFirstPoint
                        Else
                            currentindex = indexlist.Item(indexlist.Count - 1)
                            Dim temppoint = Linelist.Item(indexlist.Item(indexlist.Count - 1)).GetClosestPointTo(bopointlist.Item(indexlist.Count - 1), False)
                            point_mark = Math.Round(Linelist.Item(indexlist.Item(indexlist.Count - 1)).GetParameterAtPoint(temppoint))
                            If temppoint.DistanceTo(Linelist.Item(indexlist.Item(indexlist.Count - 1)).StartPoint) <= temppoint.DistanceTo(Linelist.Item(indexlist.Item(indexlist.Count - 1)).EndPoint) Then
                                currentline = New Line(Linelist.Item(indexlist.Item(indexlist.Count - 1)).StartPoint, Linelist.Item(indexlist.Item(indexlist.Count - 1)).EndPoint)
                            Else
                                currentline = New Line(Linelist.Item(indexlist.Item(indexlist.Count - 1)).EndPoint, Linelist.Item(indexlist.Item(indexlist.Count - 1)).StartPoint)
                            End If
                            GoTo SearchPoint
                        End If
                    Else
                        Dim NextAngle As Double = -1
                        Dim NextPoint As Point3d
                        Dim NextIndex As Integer
                        Dim count_value As Integer = 0
                        Dim NonArray = New ArrayList()
                        For Each mark_value In temp_arr
                            If mark_value = point_mark Then
                                Dim temppoint As Point3d = Linelist.Item(count_value).GetClosestPointTo(bopointlist.Item(indexlist.Count - 1), False)
                                Dim end_para As Integer
                                Try
                                    Dim t_value = Linelist.Item(count_value).GetParameterAtPoint(temppoint)
                                    end_para = Linelist.Item(count_value).EndParam - Math.Round(t_value)
                                Catch ex As Exception
                                    If temppoint.DistanceTo(Linelist.Item(count_value).StartPoint) < 0.001 Then
                                        end_para = 1
                                    Else
                                        end_para = 0
                                    End If
                                End Try
                                Dim end_point = Linelist.Item(count_value).GetPointAtParameter(end_para)
                                Dim C_Angle = lineangle(currentline, New Line(bopointlist.Item(indexlist.Count - 1), end_point))
                                If C_Angle > NextAngle AndAlso Math.Abs(C_Angle - Math.PI * 2) > 0.01 Then
                                    NextAngle = C_Angle
                                    NextPoint = end_point
                                    NextIndex = count_value
                                    NextMark = end_para
                                ElseIf C_Angle > NextAngle AndAlso Math.Abs(C_Angle - Math.PI * 2) <= 0.01 Then
                                    NonArray.Add(count_value)
                                End If
                            End If
                            count_value = count_value + 1
                        Next
                        point_mark = NextMark
                        If NonArray.Count > 0 Then
                            For Each Nonvalue In NonArray
                                temp_arr.Item(Nonvalue) = 2
                            Next
                        End If
                        temp_arr.Item(NextIndex) = 2
                        cross_arr.Item(currentindex) = temp_arr
                        cross_arr.Item(NextIndex).Item(currentindex) = 2
                        currentindex = NextIndex
                        bopointlist.Add(NextPoint)
                        indexlist.Add(NextIndex)
                        If NextPoint.DistanceTo(Linelist.Item(currentindex).StartPoint) <= NextPoint.DistanceTo(Linelist.Item(currentindex).EndPoint) Then
                            currentline = New Line(Linelist.Item(currentindex).StartPoint, Linelist.Item(currentindex).EndPoint)
                        Else
                            currentline = New Line(Linelist.Item(currentindex).EndPoint, Linelist.Item(currentindex).StartPoint)
                        End If
                        If indexlist.Count > 1 AndAlso NextPoint.DistanceTo(FisrtPoint) < 0.05 Then
                            GoTo Finished
                        End If
                    End If
                End While
            End While
Finished:
            If indexlist.Count < 1 Then
                acDocEd.WriteMessage("不存在封闭区域")
            Else
                Dim FinalCount = 0
                For Each point As Point3d In bopointlist
                    FinalBoPline.AddVertexAt(FinalCount, New Point2d(point.X, point.Y), 0, 0, 0)
                    FinalCount = FinalCount + 1
                Next
                FinalBoPline.Closed = True
            End If
        End Using
        Return FinalBoPline
    End Function

'交点打断函数
Public Shared Function BlkInt2(ssedge As ArrayList, tr As Transaction) As ArrayList
        Dim objpts As Dictionary(Of Curve, List(Of Double))
        Dim linelist = New ArrayList()
        objpts = New Dictionary(Of Curve, List(Of Double))(ssedge.Count)

        '#Region "边界与打断相同(优化)"
        Dim cvs As Curve() = New Curve(ssedge.Count - 1) {}
        For i As Integer = ssedge.Count - 1 To -1 + 1 Step -1
            Dim cv As Curve = ssedge(i)
            cvs(i) = cv
            objpts.Add(cv, New List(Of Double)())
        Next
        For cur As Integer = cvs.Length - 1 To -1 + 1 Step -1
            Dim cv1 As Curve = cvs(cur)
            Dim cv1ps As List(Of Double) = objpts(cv1)
            For n As Integer = cur To -1 + 1 Step -1
                Dim cv2 As Curve = cvs(n)
                Dim cv2ps As List(Of Double) = objpts(cv2)
                Dim points As New Point3dCollection()
                Dim pt1Param, pt2Param As Double
                cv1.IntersectWith(cv2, Intersect.OnBothOperands, points, 0, 0)
                Dim pt1 = New Point3d()
                Dim pt2 = New Point3d()
                For Each pt As Point3d In points
                    pt1 = cv1.GetClosestPointTo(pt, False)
                    pt1Param = cv1.GetParameterAtPoint(pt1)
                    If pt1Param > cv1.EndParam Then
                        cv1ps.Add(cv1.EndParam)
                    ElseIf pt1Param < 0 Then
                        cv1ps.Add(0)
                    Else
                        cv1ps.Add(cv1.GetParameterAtPoint(pt1))
                    End If
                    pt2 = cv2.GetClosestPointTo(pt, False)
                    pt2Param = cv2.GetParameterAtPoint(pt2)
                    If pt2Param > cv2.EndParam Then
                        cv2ps.Add(cv2.EndParam)
                    ElseIf pt2Param < 0 Then
                        cv2ps.Add(0)
                    Else
                        cv2ps.Add(cv2.GetParameterAtPoint(pt2))
                    End If
                Next
                pt1 = cv1.GetClosestPointTo(cv2.StartPoint, False)
                If pt1.DistanceTo(cv2.StartPoint) < 0.1 Then
                    pt1Param = cv1.GetParameterAtPoint(pt1)
                    If pt1Param > cv1.EndParam Then
                        cv1ps.Add(cv1.EndParam)
                    ElseIf pt1Param < 0 Then
                        cv1ps.Add(0)
                    Else
                        cv1ps.Add(cv1.GetParameterAtPoint(pt1))
                    End If
                End If
                pt1 = cv1.GetClosestPointTo(cv2.EndPoint, False)
                If pt1.DistanceTo(cv2.EndPoint) < 0.1 Then
                    pt1Param = cv1.GetParameterAtPoint(pt1)
                    If pt1Param > cv1.EndParam Then
                        cv1ps.Add(cv1.EndParam)
                    ElseIf pt1Param < 0 Then
                        cv1ps.Add(0)
                    Else
                        cv1ps.Add(cv1.GetParameterAtPoint(pt1))
                    End If
                End If
                pt2 = cv2.GetClosestPointTo(cv1.StartPoint, False)
                If pt2.DistanceTo(cv1.StartPoint) < 0.1 Then
                    pt2Param = cv2.GetParameterAtPoint(pt2)
                    If pt2Param > cv2.EndParam Then
                        cv2ps.Add(cv2.EndParam)
                    ElseIf pt2Param < 0 Then
                        cv2ps.Add(0)
                    Else
                        cv2ps.Add(cv2.GetParameterAtPoint(pt2))
                    End If
                End If
                pt2 = cv2.GetClosestPointTo(cv1.EndPoint, False)
                If pt2.DistanceTo(cv1.EndPoint) < 0.1 Then
                    pt2Param = cv2.GetParameterAtPoint(pt2)
                    If pt2Param > cv2.EndParam Then
                        cv2ps.Add(cv2.EndParam)
                    ElseIf pt2Param < 0 Then
                        cv2ps.Add(0)
                    Else
                        cv2ps.Add(cv2.GetParameterAtPoint(pt2))
                    End If
                End If
            Next
            '#End Region
        Next
        For Each var As KeyValuePair(Of Curve, List(Of Double)) In objpts
            Dim cv As Curve = var.Key
            If var.Value.Count = 0 Then
                Continue For
            End If
            If var.Value.Count = 1 AndAlso cv.IsPeriodic AndAlso cv.IsPersistent Then
                Continue For
            End If
            var.Value.Sort()
            Dim arrpt As Double() = New Double(var.Value.Count - 1) {}
            var.Value.CopyTo(arrpt)
            Dim pts As New DoubleCollection(arrpt)
            Dim objs As DBObjectCollection = cv.GetSplitCurves(pts)
            Dim brkn As Integer = 0
            For Each dbobj As DBObject In objs
                Dim brks As Curve = DirectCast(dbobj, Curve)
                If cv.GetDistanceAtParameter(brks.EndParam) > 0.000001 Then
                    brkn += 1
                    linelist.Add(brks)
                End If
            Next
        Next
        Return linelist
    End Function

上一篇:ios开发学习笔记(这里一定有你想要的东西,全部免费)


下一篇:附加路径中的所有文件并通过电子邮件发送