[Jnas]

Здравствуйте ув.-мые форумчанины.
К сожалению с LISP не знаком (изучал другие языки) . Сложилась следующая ситуация, мне постоянно присылают для работы чертежи, в которых куча A3 - A4 форматов на одной оси координат, но в разных слоях.
Вопрос, можно ли сместить объекты к примеру на 420 мм.

Я понимаю как это будет выглядеть на других языках программирование. но к сожалению с автокадовским ничем не знаком....

переменная1 = 0
получить все слои, запустить перебор{
выбрать все объекты слоя и сместить на переменная1
далее переменная1 = переменная1 + 420
}
и это всё в цикле

Прошу помощи, заранее спасибо!

[Boxa]

Ничего не понял из объяснений о том что должна делать программа, однако должен заметить, что автокад поддерживает технологии СОМ и ActiveX, а соответственно язык не так уж и принципиален, VB, Delphi, С, весь набор .net платформы и прочие.
Так что,

Сообщение от Jnas К сожалению с LISP не знаком (изучал другие языки)

, совсем не повод для того, чтобы ничего не писать.

[Jnas]

Сообщение от Boxa совсем не повод для того, чтобы ничего не писать

Да я не говорю , что это повод и не говорю, что ничего не пытаюсь, но не одним из этих языков я не знаком, xHDL, ассемблер некоторых микропроцессоров и т.д. вот моё
пытался что то сделать на VB, кроме как вытащить все слои чертежа больше ничего не получилось и то из интерета нашел решение больше усё....

Смысл программы прост, берем все слои и циклов проходим
в первом слое все объекты смещаем на 420мм относительносто того, где они сейчас стоят
во втором слое все объекты смещаем на 840мм относительносто того, где они сейчас стоят
в третьем слое все объекты смещаем на 1680мм относительносто того, где они сейчас стоят и т.д.

[Boxa]

Сообщение от Jnas пытался что то сделать на VB, кроме как вытащить все слои чертежа больше ничего не получилось

Так после этого совсем немного осталось, пара циклов и Вы в "дамках"

Нижеприведенный код я даже не запускал, но думаю идея понятна

Код:

[Выделить все]

Sub srfgjsr()
    Dim layerName(2) As String
    layerName(0) = "0"
    layerName(1) = "Wall"
    layerName(2) = "Opening"
    
    Dim c As Collection
    Set c = New Collection
    For i = LBound(layerName) To UBound(layerName)
        c.Add 420 * i, layerName(i)
    Next
    
    
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")

    Mode = acSelectionSetAll
    ssetObj.Select Mode

    On Error Resume Next
    
    For Each i In ssetObj
        Dim point1(0 To 2) As Double
        Dim point2(0 To 2) As Double
        point1(0) = 0: point1(1) = 0: point1(2) = 0
        point2(0) = c.Item(i.Layer): point2(1) = 0: point2(2) = 0
        i.Move point1, point2
    Next

End Sub

[Jnas]

Спасибо за подсказку все работает
сделал так

Код:

[Выделить все]

Sub srfgj()
    Dim c As Collection
    Set c = New Collection
    Dim inc As Integer
    inc = 1

    For Each entry In ThisDrawing.Layers
        c.Add 420 * inc, entry.Name
        inc = inc + 1
    Next

    Dim sssetObj As AcadSelectionSet
    Set sssetObj = ThisDrawing.SelectionSets.Add("SET")

    Mode = acSelectionSetAll
    sssetObj.Select Mode

    On Error Resume Next

    For Each i In sssetObj
        Dim point1(0 To 2) As Double
        Dim point2(0 To 2) As Double
        point1(0) = 0: point1(1) = 0: point1(2) = 0
        point2(0) = c.Item(i.Layer): point2(1) = 0: point2(2) = 0
        i.Move point1, point2
    Next
End Sub