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)
DimlCmd 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
潜艇“rysujOdPomocniczy”应该做什么？它需要复制lnL1吗，还是只需要更改起点和终点？ 可能有帮助的一件事是将这些行移到If语句之前，以准备任何意外事件：
Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
lnL1 = CType(trn.GetObject(lnL1.ObjectId, OpenMode.ForWrite), Line) 是的，它需要制作一个lnL1的副本，或者只是用指定的起点和终点绘制不同的线。它做什么呢？它画一条临时线，然后sub szukajPtk检查它是否与某物相交 或者我有没有可能只更新lnL1？
如果不需要副本，我会这么做。 但是当我尝试更新这些行时会导致错误
btr.AppendEntity(lnL1)
trn.AddNewlyCreatedDBObject(lnL1, True)
如果不需要额外的代码行，那么这些代码行将被删除。换句话说，如果原始直线图元只需要修改，则无需追加图元或添加新创建的对象。
只是：
lnL1 = CType(trn.GetObject(lnL1.ObjectId, OpenMode.ForWrite), Line)
和
lnL1.StartPoint = tmpPt1
lnL1.EndPoint = tmpPt2 是的
你总是对的thx 不客气。
谁知道这会持续多久？
页:
[1]