Макрос VBA для сортировки таблицы в AutoCA

Данный макрос предназначен для сортировки данных в таблице AutoCAD по выбранному столбцу. Он поддерживает сортировку как числовых значений, так и строковых данных.

Описание программы

Макрос позволяет пользователю выбрать таблицу в чертеже AutoCAD и отсортировать её строки по указанному столбцу. Сортировка может выполняться как по числовым данным, так и по текстовым значениям. Если пользователь не вводит номер столбца, по умолчанию используется столбец с индексом 0. Программа автоматически определяет тип данных и применяет соответствующий алгоритм сортировки. По завершении сортировки значения в таблице обновляются, и выводится сообщение об успешном выполнении операции.

Описание кода

• Инициализация объектов:
  acadApp, acadDoc — доступ к приложению AutoCAD и активному документу.
  SelectionSet — создается или переопределяется набор выбора для выбора таблицы.
• Выбор таблицы:
  Пользователь выбирает таблицу на чертеже.
  Проводится проверка: выбран ли объект и является ли он типом AcadTable.
• Выбор столбца для сортировки:
  Используется InputBox с номером столбца по умолчанию (0).
  Проверяется корректность ввода и диапазон индекса столбца.
• Извлечение данных из таблицы:
  Считываются значения выбранного столбца в массивы values() (числа) и textValues() (строки).
  Определяется тип данных столбца.
• Сортировка данных:
  Применяется алгоритм пузырьковой сортировки:
  Для числовых значений — по возрастанию.
  Для текстовых значений — в лексикографическом порядке.
• Запись отсортированных данных:
  Обновление таблицы с помощью SetText.
• Завершение работы:
  Выводится сообщение о завершении сортировки.
  Удаляется временный SelectionSet.

Sub SortAutoCADTable()

Dim acadApp As Object

Dim acadDoc As Object

Dim selSet As AcadSelectionSet

Dim selTable As AcadTable

Dim colIndex As Integer

Dim rowCount As Integer

Dim values() As Double

Dim textValues() As String

Dim i As Integer, j As Integer

Dim temp As Double

Dim tempText As String

Dim isNumericColumn As Boolean

Dim userInput As String

' Получаем доступ к AutoCAD

Set acadApp = GetObject(, "AutoCAD.Application")

Set acadDoc = acadApp.ActiveDocument

' Создаем SelectionSet (если уже есть, удаляем)

On Error Resume Next

Set selSet = acadDoc.SelectionSets("TableSelection")

If Not selSet Is Nothing Then selSet.Delete

Set selSet = acadDoc.SelectionSets.Add("TableSelection")

On Error GoTo 0

' Запрашиваем у пользователя выбор таблицы

acadDoc.Utility.Prompt "Выберите таблицу и нажмите Enter."

selSet.SelectOnScreen

' Проверяем, был ли выбран объект

If selSet.Count = 0 Then

MsgBox "Таблица не выбрана!", vbExclamation

Exit Sub

End If

' Получаем объект таблицы

Set selTable = selSet.Item(0)

If Not TypeOf selTable Is AcadTable Then

MsgBox "Выбранный объект не является таблицей!", vbExclamation

Exit Sub

End If

' Запрашиваем у пользователя номер столбца (по умолчанию 0)

userInput = InputBox("Введите номер столбца (начиная с 0):", "Выбор столбца", "0")

' Проверяем, введено ли число

If Not IsNumeric(userInput) Then

MsgBox "Введите корректное число!", vbCritical

Exit Sub

End If

colIndex = CInt(userInput)

' Проверяем диапазон столбцов

If colIndex < 0 Or colIndex >= selTable.Columns Then

MsgBox "Некорректный номер столбца!", vbCritical

Exit Sub

End If

' Получаем количество строк (без заголовка)

rowCount = selTable.Rows - 1

If rowCount < 1 Then

MsgBox "В таблице недостаточно строк для сортировки!", vbExclamation

Exit Sub

End If

' Заполняем массив значений

ReDim values(rowCount - 1)

ReDim textValues(rowCount - 1)

isNumericColumn = True

For i = 1 To rowCount

Dim cellValue As String

cellValue = Trim(selTable.GetText(i, colIndex))

' Проверяем, число ли это

If IsNumeric(cellValue) Then

values(i - 1) = CDbl(cellValue)

Else

isNumericColumn = False

textValues(i - 1) = cellValue

End If

Next i

' Сортировка данных

If isNumericColumn Then

For i = 0 To UBound(values) - 1

For j = i + 1 To UBound(values)

If values(i) > values(j) Then

temp = values(i)

values(i) = values(j)

values(j) = temp

End If

Next j

Next i

For i = 1 To rowCount

selTable.SetText i, colIndex, CStr(values(i - 1))

Next i

Else

For i = 0 To UBound(textValues) - 1

For j = i + 1 To UBound(textValues)

If textValues(i) > textValues(j) Then

tempText = textValues(i)

textValues(i) = textValues(j)

textValues(j) = tempText

End If

Next j

Next i

For i = 1 To rowCount

selTable.SetText i, colIndex, textValues(i - 1)

Next i

End If

MsgBox "Сортировка завершена!", vbInformation

' Очистка SelectionSet

selSet.Delete

End Sub

Макрос обеспечивает эффективную сортировку данных в таблицах AutoCAD, упрощая работу с проектной документацией и повышая производительность пользователя.