acad

Sub MoveSectionByName()
    Dim obj As AcadEntity
    Dim sectionObj As AcadSection
    Dim found As Boolean
    found = False

    ' Проходим по всем объектам в ModelSpace
    For Each obj In ThisDrawing.ModelSpace
        ' Проверяем, является ли объект сечением (SectionPlane)
        If obj.ObjectName = "AcDbSection" Then
            Set sectionObj = obj
            ' Проверяем имя сечения (например, по пользовательскому атрибуту или названию)
            If sectionObj.Name = "sh1" Then
                found = True
                Exit For
            End If
        End If
    Next obj
    
    If found Then
        ' Перемещаем сечение на 200 единиц по оси X
        Dim basePoint(0 To 2) As Double
        Dim displacement(0 To 2) As Double
        
        basePoint(0) = 0: basePoint(1) = 0: basePoint(2) = 0
        displacement(0) = 200: displacement(1) = 0: displacement(2) = 0
        
        sectionObj.Move basePoint, displacement
        MsgBox "Сечение 'sh1' было перемещено на 200 единиц по оси X."
    Else
        MsgBox "Сечение с именем 'sh1' не найдено."
    End If
End Sub






Получаем точку назначения по оси X от пользователя
    targetPoint = ThisDrawing.Utility.GetPoint(basePoint, "Укажите новую точку для перемещения по оси X: ")
    
    ' Вычисляем смещение по оси X
    displacement(0) = targetPoint(0) - basePoint(0) ' Смещение по X
    displacement(1) = 0 ' Оставляем ось Y без изменений
    displacement(2) = 0 ' Оставляем ось Z без изменений
    
    ' Перемещаем объект на заданное расстояние по оси X
    obj.Move basePoint, displacement