vb.net array.sort help

[shirazbj]

Hi,

 

I am trying to sort an array named xc which stores center corrdinate of selected circles,like this:

 

Array.Sort(xc)

 

After sorting, the value of xc all became 0. Don't know why?

 

But I tried this sort method with a vb.net only code, without relation to AutoCAD,and it gives me correct result.

 

Below is the code for AutoCAD and have a wrong result.

 

Thanks in advance

 

Cean

 

 

 

Dim sb As StringBuilder = New StringBuilder

Dim xc(20) As Double

Dim cnt As Integer
cnt = 0

...

For Each acSSObj As SelectedObject In acSSet

...

Select Case (acEnt.GetRXClass.Name)
      Case "AcDbCircle"
           Dim tcircle As Circle = CType(acEnt, Circle)
           If (Not (tcircle) Is Nothing) Then
              Dim c_pt As Point3d = tcircle.Center
              xc(cnt) = c_pt.X
              yc(cnt) = c_pt.Y
              r(cnt) = tcircle.Diameter
              cnt = cnt + 1
           End If
      Exit Select
End Select

...

Next

cnt = cnt - 1
sb.Append(("cnt=" + cnt.ToString + carret))

sb.Append(("before" + carret))
For i = 0 To cnt
   sb.Append(("Point Number,X,Y,Z," + xc(i).ToString + carret))
Next i

Array.Sort(xc)

sb.Append(("after" + carret))
For i = 0 To cnt
   sb.Append(("Point Number,X,Y,Z," + xc(i).ToString + carret))
   Console.WriteLine(xc(i).ToString)
Next i

[shirazbj]

This is the vb.net only code. It works.

But don't know why the first post for AutoCAD one does not work.

 

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

       Dim IntArr(3) As Double

       IntArr(0) = 5.2
       IntArr(1) = 8.3
       IntArr(2) = 9.1
       IntArr(3) = 2.5

       Array.Sort(IntArr)

       For i = 0 To 3
           Debug.Print(i.ToString + " " + IntArr(i).ToString)
       Next

   End Sub

[Jeff H]

Since you do not know the total number of circles just use a generic list and the Sort() method only knows how to sort basic data types. It does not know if you want to sort by radius, center etc.....

So you can use one of the overloaded Sort methods and pass in Comparison method.

 

You could use a lamba but this shows sorting a list of circles by the Center.X and Center.Y property and printing them out to the command line

 

       <CommandMethod("ArrayOfCircles")> _
       Public Sub ArrayOfCircles()
           Dim doc As Document = Application.DocumentManager.MdiActiveDocument
           Dim db As Database = doc.Database
           Dim ed As Editor = doc.Editor
           Using trx As Transaction = db.TransactionManager.StartTransaction()
               Dim bt As BlockTable = trx.GetObject(db.BlockTableId, OpenMode.ForWrite)
               Dim modelBtr As BlockTableRecord = trx.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForRead)
               Dim circleList As New List(Of Circle)
               For Each objId As ObjectId In modelBtr
                   If objId.ObjectClass = RXClass.GetClass(GetType(Circle)) Then
                       circleList.Add(trx.GetObject(objId, OpenMode.ForRead))
                   End If
               Next
               circleList.Sort(AddressOf CompareXCenter)
               ed.WriteMessage("{0}Sorted by X center", Environment.NewLine)
               For Each c As Circle In circleList
                   ed.WriteMessage("{0}{1}", Environment.NewLine, c.Center.ToString())
               Next
               circleList.Sort(AddressOf CompareYCenter)
               ed.WriteMessage("{0}Sorted by Y center", Environment.NewLine)
               For Each c As Circle In circleList
                   ed.WriteMessage("{0}{1}", Environment.NewLine, c.Center.ToString())
               Next
               trx.Commit()

           End Using
       End Sub

       Private Shared Function CompareXCenter(ByVal c1 As Circle, ByVal c2 As Circle) As Integer
           Return c1.Center.X.CompareTo(c2.Center.X)
       End Function
       Private Shared Function CompareYCenter(ByVal c1 As Circle, ByVal c2 As Circle) As Integer
           Return c1.Center.Y.CompareTo(c2.Center.Y)
       End Function

[shirazbj]

Hi Jeff,

 

You are using a list of objects instead of my array of doubles.

 

But sort by x center & y center seperately is exact what I want. I can now dimension all the selected circles continuesly in both directions.

 

Thank you very much

 

Cean

[Jeff H]

Uses a list of circles

[Jeff H]

Also you can use LINQ

http://www.theswamp.org/index.php?topic=39723.0

[fixo]

You might use classic comparer as well:

SortCommands.vb

 
Imports System.Collections.Generic
Imports System.Runtime.InteropServices
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput

<Assembly: CommandClass(GetType(TesterVB.SortCommands))> 
Namespace TesterVB
   Public Class SortCommands
       <CommandMethod("SCRC", CommandFlags.UsePickSet And CommandFlags.Redraw)> _
       Public Sub SortCircles()
           Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
           Dim db As Database = doc.Database
           Dim ed As Editor = doc.Editor
           Dim height As Double = 0.2
           Dim color As Integer = 256
           Dim tid As ObjectId = ObjectId.Null
           Dim ar As New ArrayList()
           Dim tr As Transaction = db.TransactionManager.StartTransaction()
           Using tr
               Dim tv As TypedValue() = New TypedValue() {New TypedValue(CInt(DxfCode.Start), "CIRCLE")}
               Dim flt As New SelectionFilter(tv)
               Dim res As PromptSelectionResult
               res = ed.GetSelection(flt)
               If res.Status <> PromptStatus.OK Then
                   Return
               End If
               Dim sset As SelectionSet = res.Value
               Dim n As Integer = 0
               For Each obj As SelectedObject In sset
                   Dim dbobj As DBObject = tr.GetObject(obj.ObjectId, OpenMode.ForRead) 'or:
                   'Dim dbobj As DBObject = obj.ObjectId.GetObject(OpenMode.ForRead)
                   Dim circ As Circle = TryCast(dbobj, Circle)
                   If circ IsNot Nothing Then
                       If n = 0 Then
                           Dim pt As Point3d = circ.Center
                           Dim cid As ObjectId = circ.ObjectId
                           Dim kp As New KeyValuePair(Of ObjectId, Point3d)(cid, pt)
                           ar.Add(kp)
                       End If
                   End If
               Next
               ed.WriteMessage(vbLf & "Count = " + ar.Count.ToString())
               ar.Sort(New PointYComparer())
               ar.Sort(New PointXYComparer()) 'sort twice to set order as for graph
               Dim rows As Integer = GetRowsByFuzz(ar, 0.1)
               Dim columns As Integer = GetColumnsByFuzz(ar, 0.1)
               ed.WriteMessage(String.Format(Environment.NewLine & "Rows: {0}; Columns: {1}", rows, columns))
               Try
                   Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                   Dim cnt As Integer = 0
                   For i As Integer = rows To 1 Step -1
                       For j As Integer = columns To 1 Step -1
                           Dim p As KeyValuePair(Of ObjectId, Point3d) = DirectCast(ar(cnt), KeyValuePair(Of ObjectId, Point3d))
                           Dim txt As New DBText()
                           txt.SetDatabaseDefaults()
                           txt.Height = 1.0
                           txt.HorizontalMode = TextHorizontalMode.TextCenter
                           txt.VerticalMode = TextVerticalMode.TextVerticalMid
                           txt.Position = p.Value
                           txt.AlignmentPoint = txt.Position
                           txt.TextString = (cnt + 1).ToString
                           btr.AppendEntity(txt)
                           tr.AddNewlyCreatedDBObject(txt, True)
                           cnt += 1
                       Next
                   Next
                   tr.Commit()
                   ed.WriteMessage(String.Format(Environment.NewLine & "Done"))
                   ed.UpdateScreen()
               Catch ex As System.Exception
                   ed.WriteMessage(ex.ToString)
               End Try
           End Using
       End Sub

       Public Function GetRowsByFuzz(ByVal ar As ArrayList, ByVal fuzz As Double) As Integer
           Dim cnt As Integer = 0
           Dim p As KeyValuePair(Of ObjectId, Point3d) = DirectCast(ar(0), KeyValuePair(Of ObjectId, Point3d))
           Dim match As Double = p.Value.X
           For Each kp As KeyValuePair(Of ObjectId, Point3d) In ar
               If Math.Abs(match - kp.Value.X) < fuzz Then
                   cnt += 1
               End If
           Next
           Return cnt
       End Function

       Public Function GetColumnsByFuzz(ByVal ar As ArrayList, ByVal fuzz As Double) As Integer
           Dim cnt As Integer = 0
           Dim p As KeyValuePair(Of ObjectId, Point3d) = DirectCast(ar(0), KeyValuePair(Of ObjectId, Point3d))
           Dim match As Double = p.Value.Y
           For Each kp As KeyValuePair(Of ObjectId, Point3d) In ar
               If Math.Abs(match - kp.Value.Y) < fuzz Then
                   cnt += 1
               End If
           Next
           Return cnt
       End Function
   End Class
End Namespace

Module1.vb

 
Imports System.Collections.Generic
Imports System.Runtime.InteropServices
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput

Module Module1
Public Class PointYComparer
       Implements IComparer
       Private Function IComparer_Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare
           Dim a As KeyValuePair(Of ObjectId, Point3d) = DirectCast(x, KeyValuePair(Of ObjectId, Point3d))
           Dim b As KeyValuePair(Of ObjectId, Point3d) = DirectCast(y, KeyValuePair(Of ObjectId, Point3d))
           Dim result As Integer = a.Value.Y.CompareTo(b.Value.Y)
           Return result
       End Function
   End Class
   Public Class PointXYComparer
       Implements IComparer
       Private Function IComparer_Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare
           Dim a As KeyValuePair(Of ObjectId, Point3d) = DirectCast(x, KeyValuePair(Of ObjectId, Point3d))
           Dim b As KeyValuePair(Of ObjectId, Point3d) = DirectCast(y, KeyValuePair(Of ObjectId, Point3d))
           Dim result As Integer = a.Value.X.CompareTo(b.Value.X) Or a.Value.Y.CompareTo(b.Value.Y)
           Return result
       End Function
   End Class
   Public Class PointXComparer
       Implements IComparer
       Private Function IComparer_Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare
           Dim a As KeyValuePair(Of ObjectId, Point3d) = DirectCast(x, KeyValuePair(Of ObjectId, Point3d))
           Dim b As KeyValuePair(Of ObjectId, Point3d) = DirectCast(y, KeyValuePair(Of ObjectId, Point3d))
           Dim result As Integer = a.Value.X.CompareTo(b.Value.X)
           Return result
       End Function
   End Class
   Public Class PointYXComparer
       Implements IComparer
       Private Function IComparer_Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare
           Dim a As KeyValuePair(Of ObjectId, Point3d) = DirectCast(x, KeyValuePair(Of ObjectId, Point3d))
           Dim b As KeyValuePair(Of ObjectId, Point3d) = DirectCast(y, KeyValuePair(Of ObjectId, Point3d))
           Dim result As Integer = a.Value.Y.CompareTo(b.Value.Y) Or a.Value.X.CompareTo(b.Value.X)
           Return result
       End Function
   End Class
End Module

It should work good if your circles were positioned like a grid

 

~'J'~