PanHasan Posted August 31, 2009 Posted August 31, 2009 Hi my problem is simple I think but I couldn't get rid of it. The program crashes because I'm trying to add object that is already in the drawing if im wrong please correct me and I don't know how to fix this maybe some kind of update function ? <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 Quote
SEANT Posted August 31, 2009 Posted August 31, 2009 What is the sub "rysujOdPomocniczy" suppose to do? Does it need to make a copy of lnL1, or just change the start- and endpoint? Quote
SEANT Posted August 31, 2009 Posted August 31, 2009 One thing that may help is to move these lines before the If Statements to prepare for any of the contingencies: Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite) lnL1 = CType(trn.GetObject(lnL1.ObjectId, OpenMode.ForWrite), Line) Quote
PanHasan Posted August 31, 2009 Author Posted August 31, 2009 Yes it need to make a copy of lnL1 or just draw different lines with specified start and end points. What does it do it draw a temporary line and then sub szukajPtk checks if it intersects with something Quote
PanHasan Posted August 31, 2009 Author Posted August 31, 2009 or is there any chance that i just update the lnL1 ? Quote
SEANT Posted August 31, 2009 Posted August 31, 2009 or is there any chance that i just update the lnL1 ? If there is not a need for a copy, that is what I would do. Quote
PanHasan Posted August 31, 2009 Author Posted August 31, 2009 but when i try to update this lines causes an error btr.AppendEntity(lnL1) trn.AddNewlyCreatedDBObject(lnL1, True) Quote
SEANT Posted August 31, 2009 Posted August 31, 2009 If there is no need for an additional line then those lines of code would be removed. In other words, if the original line entity only needs modification then there is no need to Append Entity or Add Newly Created Object. Just: lnL1 = CType(trn.GetObject(lnL1.ObjectId, OpenMode.ForWrite), Line) and lnL1.StartPoint = tmpPt1 lnL1.EndPoint = tmpPt2 Quote
SEANT Posted August 31, 2009 Posted August 31, 2009 You are welcome. . . . .You're right as always. . . . Who knows how long that will keep up? Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.