[编程交流] vb中的2d数组。网

Dim Tab() As Point3d

    <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
           Dim lnNajblizsza As Line = Nothing
           'TRANSAKCJA
           przecieciaPromienia(promienSledzacy, tabID, prevPt, nextPt, lnNajblizsza)
           'Sprawdzenie ktury punkt jest nizej
           Dim START As Point3d
           Dim FIN As Point3d
           If lnNajblizsza.StartPoint.Y > lnNajblizsza.EndPoint.Y Then
               START = lnNajblizsza.EndPoint
           Else
               START = lnNajblizsza.StartPoint
           End If
       End If
   End Sub
   Public Sub przecieciaPromienia(ByRef promienSledzacy As Ray, ByRef tabID() As ObjectId, ByRef prevPt As Point3d, ByRef nextPt As Point3d, ByRef lnNajblizsza As Line)
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = lCmd.Document.Database
       Dim trn As Transaction = acBaza.TransactionManager.StartTransaction
       Try
           Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
           Dim objID As ObjectId
           Dim ra3d As Ray3d = New Ray3d(promienSledzacy.StartPoint, promienSledzacy.SecondPoint)
           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)
                   lnNajblizsza = ln
               ElseIf odl >= odlTmp Then
                   nextPt = ptkPrzeciecia.Item(0)
                   lnNajblizsza = ln
               End If
           Next
           lnNajblizsza.Highlight()
           promienSledzacy.SetDatabaseDefaults()
           btr.AppendEntity(promienSledzacy)
           trn.AddNewlyCreatedDBObject(promienSledzacy, True)
           trn.Commit()
       Catch ex As Exception
       Finally
           trn.Dispose()
       End Try
   End Sub

    <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 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 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 = ssLinie.GetObjectIds
               Dim oid As ObjectId
               'TRANSAKCJA
               oid = przecieciaPromienia(ls3d, tabID, prevPt, nextPt)
               Dim lnNajblizsza As Line = CType(trn.GetObject(oid, OpenMode.ForRead), Line)
               'Sprawdzenie ktury punkt jest nizej
               Dim START As Point3d
               'Dim FIN As Point3d
               If lnNajblizsza.StartPoint.Y > lnNajblizsza.EndPoint.Y Then
                   START = lnNajblizsza.EndPoint
               Else
                   START = lnNajblizsza.StartPoint
               End If
           End If
           trn.Commit()
       End Using
   End Sub
   Public Function przecieciaPromienia(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)
                   ElseIf odl >= odlTmp Then
                       nextPt = ptkPrzeciecia.Item(0)
                   End If
                   lnNajblizsza = ln
               Next
               lnNajblizsza.Highlight()
               Dim promienSledzacy As Ray = New Ray()
               promienSledzacy.BasePoint = ls3d.StartPoint
               promienSledzacy.SecondPoint = ls3d.EndPoint
               promienSledzacy.SetDatabaseDefaults()
               btr.AppendEntity(promienSledzacy)
               trn.AddNewlyCreatedDBObject(promienSledzacy, True)
               trn.Commit()
           Catch ex As Exception
           End Try
           Return lnNajblizsza.ObjectId
       End Using
   End Function