Jump to content

Recommended Posts

Posted

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

Posted

What is the sub "rysujOdPomocniczy" suppose to do? Does it need to make a copy of lnL1, or just change the start- and endpoint?

Posted

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)

Posted

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

Posted

or is there any chance that i just update the lnL1 ?

Posted
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.

Posted

but when i try to update this lines causes an error

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

Posted

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

Posted

You are welcome.

 

 

. . . .

You're right as always. . . .

 

Who knows how long that will keep up? :)

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...