[编程交流] vb。净交易问题

 <CommandMethod("src")> _
  Public Sub src()
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = lCmd.Document.Database
       Dim trn As Transaction = acBaza.TransactionManager.StartTransaction
       Dim lnL1 As Line = New Line()
       Dim usrPtOp As PromptPointOptions = New PromptPointOptions("Wskarz srodek pomieszczenia :")
       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
           Dim usrPtXmod As Point3d = New Point3d(usrPt.Value.X + 1, usrPt.Value.Y, usrPt.Value.Z)
           Dim promienSledzacy As Ray = New Ray()
           promienSledzacy.BasePoint = usrPt.Value
           promienSledzacy.SecondPoint = 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 = ssLinie.GetObjectIds
           'TRANSAKCJA
           Try
               Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
               Dim objID As ObjectId
               Dim licz As Integer = 0
               Dim ilosc As Integer = 0
               Dim ra3d As Ray3d = New Ray3d(promienSledzacy.StartPoint, promienSledzacy.SecondPoint)
               Dim lnNajblizsza As Line = Nothing
               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                    
                   If ptkPrzeciecia.Count <> ilosc Then
                       ilosc = ptkPrzeciecia.Count
                       If licz = 0 Then
                           nextPt = ptkPrzeciecia.Item(0)
                           lnNajblizsza = ln
                       End If
                       If nextPt.X >= ptkPrzeciecia.Item(licz).X Then
                           nextPt = ptkPrzeciecia.Item(licz)
                           lnNajblizsza = ln
                       End If
                       licz = licz + 1
                   End If
               Next
               promienSledzacy.SetDatabaseDefaults()
               btr.AppendEntity(promienSledzacy)
               trn.AddNewlyCreatedDBObject(promienSledzacy, True)
               trn.Commit()
           Catch ex As Exception
           Finally
               trn.Dispose()
           End Try
           Dim tmpPt2 As Point3d
           Dim przeciecia As Integer
           Dim bezpiecznik As Integer = 0
           While (bezpiecznik < 3)
               bezpiecznik = bezpiecznik + 1
               rysujOdPomocniczy(prevPt, nextPt, tmpPt2, lnL1)
               '  szukajPtk(przeciecia, prevPt, nextPt, tmpPt2, tabID, lnL1)
               If przeciecia = 0 Then
                   prevPt = tmpPt2
               Else
                   prevPt = nextPt
                   przeciecia = 0
               End If
           End While
       End If
   End Sub
   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 tmpPt1 As Point3d = prevPt
       tmpPt2 = nextPt
       ' WYZNACZANIE KATOW KTORE TRZEBA SPRAWDZIC NA PODSTWAIE POPRZEDNIEGO PUNKTU
       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 = CType(trn.GetObject(lnL1.ObjectId, OpenMode.ForWrite), Line)
               lnL1.StartPoint = tmpPt1
               lnL1.EndPoint = tmpPt2
           Else
               Try
                   Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
                   tmpPt2 = New Point3d(nextPt.X + 10, nextPt.Y, 0)
                   lnL1 = CType(trn.GetObject(lnL1.ObjectId, OpenMode.ForWrite), Line)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
                   btr.AppendEntity(lnL1)
                   trn.AddNewlyCreatedDBObject(lnL1, True)
                   lnL1.UpgradeOpen()
                   trn.Commit()
               Catch ex As Exception
                   lCmd.WriteMessage("Wyjatek")
               Finally
                   trn.Dispose()
               End Try
           End If
       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
               Try
                   Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
                   btr.AppendEntity(lnL1)
                   trn.AddNewlyCreatedDBObject(lnL1, True)
                   trn.Commit()
               Catch ex As Exception
                   lCmd.WriteMessage("Wyjatek")
               Finally
                   trn.Dispose()
               End Try
           Else
               tmpPt2 = New Point3d(nextPt.X, nextPt.Y + 10, 0)
               lnL1.StartPoint = tmpPt1
               lnL1.EndPoint = tmpPt2
           End If
       End If
   End Sub

Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)

lnL1 = CType(trn.GetObject(lnL1.ObjectId, OpenMode.ForWrite), Line)

                   btr.AppendEntity(lnL1)
                   trn.AddNewlyCreatedDBObject(lnL1, True)

lnL1 = CType(trn.GetObject(lnL1.ObjectId, OpenMode.ForWrite), Line)

lnL1.StartPoint = tmpPt1
lnL1.EndPoint = tmpPt2