C#ATIA

↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)

コレクション内のオブジェクトのプロパティを利用したソート2

こちらの続きです。
C#ATIA

Bingチャットも良いのですが、こちらのコメント欄に記載した
phindと言うサービスの存在を知りました。
Bingチャットでコードレビュー - C#ATIA

コーディングに関してはGPT-4を上回ると言う事らしいですが、
それ以上にBingチャットとは比較にならない程、返答が速いです。

同様の質問をした際の返答の回答部分はこの様な感じでした。

Function DistanceFromOrigin() As Double
   DistanceFromOrigin = Sqr(Me.x ^ 2 + Me.y ^ 2)
End Function


Function ComparePoints(point1 As Point2D, point2 As Point2D) As Long
   If point1.DistanceFromOrigin < point2.DistanceFromOrigin Then
       ComparePoints = -1
   ElseIf point1.DistanceFromOrigin > point2.DistanceFromOrigin Then
       ComparePoints = 1
   Else
       ComparePoints = 0
   End If
End Function


Sub SortPoints(points As Collection)
   Dim i As Long
   Dim j As Long
   Dim temp As Variant
   Dim hasSwapped As Boolean

   Do
       hasSwapped = False
       For i = 1 To points.Count - 1
           For j = i + 1 To points.Count
               If ComparePoints(points(i), points(j)) > 0 Then
                  Set temp = points(i)
                  Set points(i) = points(j)
                  Set points(j) = temp
                  hasSwapped = True
               End If
           Next j
       Next i
   Loop Until Not hasSwapped
End Sub

肝心のソート部分が"Function"では無く"Sub"だったので、
望んでいるものでは無かったのですが、Bingチャット同様に
スワップ処理をコレクション要素の再代入になっている為、
NGです。

その後何度かエラーを指摘し得られた回答のコード部分が
こちらです。

Public Function ComparePoints(point1 As Point2D, point2 As Point2D) As Long
 Dim distance1 As Double
 Dim distance2 As Double

 distance1 = Sqr((point1.x ^ 2) + (point1.y ^ 2))
 distance2 = Sqr((point2.x ^ 2) + (point2.y ^ 2))

 If distance1 < distance2 Then
     ComparePoints = -1
 ElseIf distance1 > distance2 Then
     ComparePoints = 1
 Else
     ComparePoints = 0
 End If
End Function


Public Function SortPoints(points As Collection) As Collection
  Dim arr() As Point2D
  Dim sortedPoints As New Collection
  Dim i As Long
  Dim j As Long
  Dim temp As Point2D

  ' Step 1: Copy all elements to temporary array
  ReDim arr(1 To points.Count)
  For i = 1 To points.Count
      Set arr(i) = points(i)
  Next i

  ' Step 2: Sort the array using bubble sort
  For i = 1 To points.Count - 1
      For j = i + 1 To points.Count
          If ComparePoints(arr(i), arr(j)) > 0 Then
              ' Swap arr(i) and arr(j)
              Set temp = arr(i)
              Set arr(i) = arr(j)
              Set arr(j) = temp
          End If
      Next j
  Next i

  ' Step 3: Create new sorted collection
  For i = LBound(arr) To UBound(arr)
      sortedPoints.Add arr(i)
  Next i

  Set SortPoints = sortedPoints
End Function

Bingチャット同様で、

コレクション→配列→ソート→コレクション

で処理されています。もうVBAでは定石な手段なのでしょう。


実は、年末に試した際に一回目の回答で得られたものに驚きました。
(控えていない上、試しに実行もしませんでした。スイマセン)
ソート関数の引数で、ソート条件をaddressOfで渡しているサンプルを
書き出したのですが、良く調べたらVBAではアドレスから関数の
呼び出しは基本的には出来ない仕様のようなので、恐らく
動かなかったかな・・・。

addressOfを利用する方法を解説しているサイトは、ここぐらいでしょう。
いげ太の日記


phindはVSCodeの拡張があります。VBAVSCodeで開発出来ないかな・・・。