[编程交流] 跟踪线。网

   <CommandMethod("src")> _
      Public Sub src()
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = lCmd.Document.Database
       Using trn As Transaction = acBaza.TransactionManager.StartTransaction
           Dim usrPtOp As PromptPointOptions = New PromptPointOptions("Wskarz srodek pomieszczenia" + vbCrLf)
           Dim usrPt As PromptPointResult = lCmd.GetPoint(usrPtOp)
           Dim prevPt As Point3d = usrPt.Value
           Dim nextPt As Point3d = usrPt.Value
           If usrPt.Status = PromptStatus.OK Then ' sprawdzenie czy poprawnie wpisano punkt poczatkowy
               Dim usrPtXmod As Point3d = New Point3d(usrPt.Value.X + 1, usrPt.Value.Y, usrPt.Value.Z)
               Dim ls3d As LineSegment3d = New LineSegment3d(usrPt.Value, usrPtXmod)
               'FILTRACJA LINII
               Dim typeValue() As TypedValue = {New TypedValue(0, "line")}
               Dim selFilter As SelectionFilter = New SelectionFilter(typeValue)
               Dim selResult As PromptSelectionResult = lCmd.SelectAll(selFilter)
               Dim ssLinie As SelectionSet = selResult.Value
               Dim tabId() As ObjectId
               If selResult.Status = PromptStatus.OK Then ' sprawdzenie czy w rysunku znajduja sie jakies linie
                   If ssLinie.Count >= 1 Then
                       tabId = ssLinie.GetObjectIds
                       Dim oid As ObjectId
                       Dim tmpPt2 As Point3d
                       Dim przeciecia As Integer
                       Dim lnL1 As Line = New Line()
                       Dim promienSledzacy As Ray = New Ray()
                       Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
                       'dodanie do rysunku lnL1 i promienia sledzacego bez parametrow jeszcze niewidoczne
                       btr.AppendEntity(lnL1)
                       trn.AddNewlyCreatedDBObject(lnL1, True)
                       btr.AppendEntity(promienSledzacy)
                       trn.AddNewlyCreatedDBObject(promienSledzacy, True)
                       ' rysowanie pierwszego promienia sledzacego
                       oid = przecieciaPromienia(promienSledzacy, ls3d, tabId, prevPt, nextPt)
                       Dim lnNajblizsza As Line = CType(trn.GetObject(oid, OpenMode.ForRead), Line)
                       'Sprawdzenie ktory punkt jest nizej
                       Dim START As Point3d
                       Dim FIN As Point3d
                       Dim PunktyPomieszczenia As Point3dCollection = New Point3dCollection()
                       If lnNajblizsza.StartPoint.Y > lnNajblizsza.EndPoint.Y Then
                           START = lnNajblizsza.EndPoint
                           PunktyPomieszczenia.Add(lnNajblizsza.EndPoint)
                           PunktyPomieszczenia.Add(lnNajblizsza.StartPoint)
                       Else
                           START = lnNajblizsza.StartPoint
                           PunktyPomieszczenia.Add(lnNajblizsza.StartPoint)
                           PunktyPomieszczenia.Add(lnNajblizsza.EndPoint)
                       End If
                       Dim IloscWszystkichLinii As Integer = tabId.Count()
                       Dim licznik As Integer = 0
                       Dim bezpiecznik As Integer = 0
                       While (licznik < IloscWszystkichLinii) And (bezpiecznik < IloscWszystkichLinii * 6)
                           rysujOdPomocniczy(prevPt, nextPt, tmpPt2, lnL1)
                           szukajPrzecieciaPomocniczego(przeciecia, prevPt, nextPt, tmpPt2, tabId, lnL1)
                           If przeciecia = 0 Then
                               prevPt = tmpPt2
                           ElseIf przeciecia = 1 Then
                               licznik = licznik + 1
                               ls3d = New LineSegment3d(nextPt, prevPt)
                               Using trn1 As Transaction = acBaza.TransactionManager.StartTransaction
                                   Try
                                       Dim btr1 As BlockTableRecord = trn1.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
                                       Dim ll As Line = CType(trn1.GetObject(lnNajblizsza.ObjectId, OpenMode.ForWrite), Line)
                                       ll.Erase()
                                       trn1.Commit()
                                   Catch ex As Exception
                                       lCmd.WriteMessage("Wyjatek w usowanie linii" + vbCrLf)
                                   Finally
                                       trn1.Dispose()
                                   End Try
                               End Using
                               'aktualizacja lini z rysunku
                               selResult = (lCmd.SelectAll(selFilter))
                               ssLinie = selResult.Value
                               tabId = ssLinie.GetObjectIds
                               'rysowanie promieni
                               oid = przecieciaPromienia(promienSledzacy, ls3d, tabId, prevPt, nextPt)
                               przeciecia = 0
                               lnNajblizsza = CType(trn.GetObject(oid, OpenMode.ForRead), Line)
                           Else
                               lCmd.WriteMessage("WIECEJ NIZ JEDNO PRZECIECIE" + vbCrLf)
                           End If
                           bezpiecznik = bezpiecznik + 1
                       End While
                       If bezpiecznik = IloscWszystkichLinii * 4 Then
                           lCmd.WriteMessage("Linia nie zakonczona")
                       End If
                   Else
                       lCmd.WriteMessage("ERROR : Mniej niz 3 linie pomieszczenie nie moze byc domkniete")
                   End If
               Else
                   lCmd.WriteMessage("ERROR : Brak linii w rysunku")
               End If
               trn.Commit()
           End If
       End Using
   End Sub
   ' RYSUJE PROMIEN SLEDZACY
   ' DRAW A TRACING RAY
   ' SZUKA LINII NAJBLIZSZEJ DANEMU PUNKTOWI
   ' SEARCH FOR THE NEAREST LINE FOR THE POINT
   Public Function przecieciaPromienia(ByRef promienSledzacy As Ray, ByRef ls3d As LineSegment3d, ByRef tabID() As ObjectId, ByRef prevPt As Point3d, ByRef nextPt As Point3d) As ObjectId
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = Application.DocumentManager.MdiActiveDocument.Database
       Dim lnNajblizsza As Line = Nothing
       Using trn As Transaction = acBaza.TransactionManager.StartTransaction
           Try
               Dim btr As BlockTableRecord = CType(trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
               Dim objID As ObjectId
               Dim ra3d As Ray3d = New Ray3d(ls3d.StartPoint, ls3d.EndPoint)
               Dim odl As Single = 0.0
               Dim odlTmp As Single = 0.0
               For Each objID In tabID
                   Dim ln As Line = CType(trn.GetObject(objID, OpenMode.ForRead), Line)
                   Dim ls As LineSegment3d = New LineSegment3d(ln.StartPoint, ln.EndPoint)
                   Dim ptArray() As Point3d = ls.IntersectWith(ra3d)
                   If ptArray Is Nothing Then Continue For
                   Dim ptkPrzeciecia As Point3dCollection = New Point3dCollection(ptArray)
                   'SZUKANIE PIERWSZEJ NAJBLIZSZEJ LINII   
                   '   odl=sqrt ((x1-x2)*(x1-x2) + (y1-y2)*(y1-y2)) 
                   odlTmp = Math.Sqrt((prevPt.X - ptkPrzeciecia.Item(0).X) * (prevPt.X - ptkPrzeciecia.Item(0).X) + (prevPt.Y - ptkPrzeciecia.Item(0).Y) * (prevPt.Y - ptkPrzeciecia.Item(0).Y))
                   If odl = 0.0 Then
                       odl = odlTmp
                       nextPt = ptkPrzeciecia.Item(0)
                       lCmd.WriteMessage("Prze:" + nextPt.ToString + "il :" + ptkPrzeciecia.Count.ToString)
                       lnNajblizsza = ln
                   ElseIf odl >= odlTmp Then
                       nextPt = ptkPrzeciecia.Item(0)
                       lCmd.WriteMessage("Prze:" + nextPt.ToString + "il :" + ptkPrzeciecia.Count.ToString)
                       lnNajblizsza = ln
                   End If
               Next
               promienSledzacy = CType(trn.GetObject(promienSledzacy.ObjectId, OpenMode.ForWrite), Ray)
               promienSledzacy.BasePoint = ls3d.StartPoint
               promienSledzacy.SecondPoint = ls3d.EndPoint
               trn.Commit()
           Catch ex As Exception
               lCmd.WriteMessage("Wyjatek w przecieciaPromienia" + ex.ToString + vbCrLf)
           End Try
           Return lnNajblizsza.ObjectId
       End Using
   End Function
   'RYSUJE MALE ODCINKI POMOCNICZE
   'DRAW A LITTLES HELP LINES
   Public Sub rysujOdPomocniczy(ByRef prevPt As Point3d, ByRef nextPt As Point3d, ByRef tmpPt2 As Point3d, ByRef lnL1 As Line)
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = lCmd.Document.Database
       Dim trn As Transaction = acBaza.TransactionManager.StartTransaction
       Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
       Dim tmpPt1 As Point3d = prevPt
       tmpPt2 = nextPt
       ' WYZNACZANIE KATOW KTORE TRZEBA SPRAWDZIC NA PODSTWAIE POPRZEDNIEGO PUNKTU
       Try
           lnL1 = CType(trn.GetObject(lnL1.ObjectId, OpenMode.ForWrite), Line)
           'Wariant I
           If Math.Round(prevPt.X) = Math.Round(nextPt.X) Then
               If nextPt.Y > prevPt.Y Then
                   tmpPt2 = New Point3d(nextPt.X - 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X + 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
               'Wariant II
           ElseIf Math.Round(prevPt.Y) = Math.Round(nextPt.Y) Then
               If nextPt.X > prevPt.X Then
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y + 10, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y - 10, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
               'Wariant III
           ElseIf Math.Round(prevPt.X) < Math.Round(nextPt.X) Then
               If nextPt.Y > prevPt.Y Then
                   tmpPt2 = New Point3d(nextPt.X - 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y + 10, 0) ' poprawiono
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
               'Wariant IV
           ElseIf Math.Round(prevPt.X) > Math.Round(nextPt.X) Then
               If nextPt.Y < prevPt.Y Then
                   tmpPt2 = New Point3d(nextPt.X + 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y - 10, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
           End If
           ' lCmd.WriteMessage(lnL1.StartPoint.ToString + "-" + lnL1.EndPoint.ToString + vbCrLf)
           trn.Commit()
       Catch ex As Exception
           lCmd.WriteMessage("Wyjatek w rysujOdPomocniczy" + vbCrLf)
       Finally
           trn.Dispose()
       End Try
   End Sub
   ' SEARCHES THE INTERS OF THE LITTLE HELP LINE
   Public Sub szukajPrzecieciaPomocniczego(ByRef przeciecia As Integer, ByRef prevPt As Point3d, ByRef nextPt As Point3d, ByRef tmpPt2 As Point3d, ByRef tabID() As ObjectId, ByRef lnL1 As Line)
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = lCmd.Document.Database
       Dim trn As Transaction = acBaza.TransactionManager.StartTransaction
       Dim Cl_crsPt As Point3dCollection = New Point3dCollection()
       Dim intPomoc1 As Integer
       Dim intPomoc2 As Integer
       Try
           Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
           Dim obj As ObjectId
           For Each obj In tabID
               Dim ln As Line = CType(trn.GetObject(obj, OpenMode.ForRead), Line)
               ln.IntersectWith(lnL1, Intersect.OnBothOperands, lnL1.GetPlane(), Cl_crsPt, intPomoc1, intPomoc2)
           Next
           przeciecia = Cl_crsPt.Count
           If Cl_crsPt.Count = 1 Then
               prevPt = Cl_crsPt.Item(0)
           ElseIf Cl_crsPt.Count > 1 Then
               lCmd.WriteMessage("Wiecej niz jedno przeciecie:" + Cl_crsPt.Count.ToString)
               Dim tmpPunkt As Point3d
               Dim odlPtkTmp As Single
               Dim odlPtk As Single
               For Each tmpPunkt In Cl_crsPt
                   odlPtkTmp = Math.Sqrt((prevPt.X - Cl_crsPt.Item(0).X) * (prevPt.X - Cl_crsPt.Item(0).X) + (prevPt.Y - Cl_crsPt.Item(0).Y) * (prevPt.Y - Cl_crsPt.Item(0).Y))
                   If odlPtk = 0.0 Then
                       odlPtk = odlPtkTmp
                       nextPt = Cl_crsPt.Item(0)
                   ElseIf odlPtk >= odlPtkTmp Then
                       nextPt = Cl_crsPt.Item(0)
                   End If
                   przeciecia = 1
               Next
           End If
           trn.Commit()
       Catch ex As Exception
           lCmd.WriteMessage("Wyjatek w szukajPrzecieciaPomocniczego" + vbCrLf)
       Finally
           trn.Dispose()
       End Try
   End Sub

Dim IloscWszystkichLinii As Integer = tabId.GetUpperBound(0) 

Dim IloscWszystkichLinii As Integer = tabId.GetUpperBound(0) + 1

Dim IloscWszystkichLinii As Integer = tabId.GetUpperBound(0) + 1

Dim IloscWszystkichLinii As Integer = ssLinie.Count

Dim IloscWszystkichLinii As Integer = tabId.Count()