Автор: Dmitry Rudenko

Скрипт ищет в чертеже все основные надписи (таблицы) и нумерует. Сортировка - слева направо, сверху вниз

Работает на основных надписях из этого файла: рамки

numerator_listov.bas

Attribute VB_Name = "numerator_listov"
Option Explicit
 
Sub numerator_listov()
 
    'подключаемся к нано
    Dim app As nanoCAD.Application
    Dim ThisDrawing As nanoCAD.Document
    Dim ms As AcadModelSpace
    Dim ut As nanoCAD.Utility
    Dim server As McCOM2.IServer
    Dim spdsobjects As McCOM2.ObjectsCollection
    Set app = GetObject("", "nanoCAD.Application")
    Set ThisDrawing = app.ActiveDocument
    Set ms = ThisDrawing.ModelSpace
    Set ut = ThisDrawing.Utility
    'подключаемся к спдс
    Set server = CreateObject("McCOM2.Server")
    Set spdsobjects = server.Query()
    app.Visible = True 'переключаемся на нано
 
    ut.Prompt "numerator_listov"
 
    Dim i As Double
    Dim m As Double
    m = 0
    Dim list(999) As Double, Xpos(999) As Double, Ypos(999) As Double
    Dim temp As Double
 
    Dim first As Double
    first = ut.GetInteger("Введите номер первого листа")
    ut.Prompt "Ждите"
    first = first - 1
 
    Dim pt0() As Double
    Dim myobj As McCOM2.Object
    For i = 1 To spdsobjects.Count
        Set myobj = spdsobjects.item(i)
        If (myobj.ClassName = "McCom2.SymTable") Then
            If (myobj.Properties.item(1).Value = "КЖ_основная_надпись") Then
                m = m + 1
                pt0 = myobj.Position
                list(m) = i
                Xpos(m) = pt0(1)
                Ypos(m) = Format((pt0(2) - myobj.Properties.item(3).Value * 59.5) / 3000, "0")
            End If
        End If
    Next
 
    Dim a As Double, b As Double
    For a = 1 To m - 1
        For b = 1 To m - 1
            If Xpos(b) > Xpos(b + 1) Then
                temp = Xpos(b)
                Xpos(b) = Xpos(b + 1)
                Xpos(b + 1) = temp
 
                temp = list(b)
                list(b) = list(b + 1)
                list(b + 1) = temp
 
                temp = Ypos(b)
                Ypos(b) = Ypos(b + 1)
                Ypos(b + 1) = temp
            End If
        Next
    Next
    For a = 1 To m - 1
        For b = 1 To m - 1
            If Ypos(b) < Ypos(b + 1) Then
                temp = Xpos(b)
                Xpos(b) = Xpos(b + 1)
                Xpos(b + 1) = temp
 
                temp = list(b)
                list(b) = list(b + 1)
                list(b + 1) = temp
 
                temp = Ypos(b)
                Ypos(b) = Ypos(b + 1)
                Ypos(b + 1) = temp
            End If
        Next
    Next
 
    For i = 1 To m
        Set myobj = spdsobjects.item(list(i))
        myobj.Cell(7, 9).text = first + i
    Next
 
    ut.Prompt "Готово"
End Sub