Cad.Net 重構折線bo函式
由於CAD自帶Bo函式，在二次開發時無論使用SendCommand方式，還是TraceBoundary函式，其精度都與視口大小掛鉤。測試程式碼如下：
‘測試cad自帶bo命令功能
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
