由于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