- Сообщения
- 2 299
- Реакции
- 853
Всем привет!
Есть такая задача: создать контуры прямоугольников для последующего раскроя плёнки на каттере.
В начале работы макроса пользователем задаётся размер ячейки (ширина, высота), размер оверката (overcut - внешние вылеты за границы ячеек), количество ячеек по горизонтали и вертикали.
Макрос "рисует" сетку раскроя с максимальной оптимизацией. Первая (верхняя) горизонтальная линия должна начинаться с левого верхнего края документа и иметь направление слева направо.
Остальные линии рисуются "ёлочкой" (зигзагом), чтобы не было "холостого" хода ножа при крое (на схеме показан стрелками направление кроя, числами - порядок следования.):
Понятно, что многие современные каттеры имеют собственный программный модуль оптимизации кроя материала. Но, увы, у нас такого нет. Кроим на принтере-каттере, где функционал кроя сводится только к параметрам силы ножа и скорости раскроя...
"Пообщавшись" с ChatGPT, родился следующий макрос, который работает с некоторыми ошибками:
Был бы признателен, если кто-нибудь поделится рабочим решением.
Спасибо.
Есть такая задача: создать контуры прямоугольников для последующего раскроя плёнки на каттере.
В начале работы макроса пользователем задаётся размер ячейки (ширина, высота), размер оверката (overcut - внешние вылеты за границы ячеек), количество ячеек по горизонтали и вертикали.
Макрос "рисует" сетку раскроя с максимальной оптимизацией. Первая (верхняя) горизонтальная линия должна начинаться с левого верхнего края документа и иметь направление слева направо.
Остальные линии рисуются "ёлочкой" (зигзагом), чтобы не было "холостого" хода ножа при крое (на схеме показан стрелками направление кроя, числами - порядок следования.):
Понятно, что многие современные каттеры имеют собственный программный модуль оптимизации кроя материала. Но, увы, у нас такого нет. Кроим на принтере-каттере, где функционал кроя сводится только к параметрам силы ножа и скорости раскроя...
"Пообщавшись" с ChatGPT, родился следующий макрос, который работает с некоторыми ошибками:
Код:
Sub CreateZigzagGrid_FixedVerticalOrder_Centered()
Dim doc As Document
Dim pg As Page
Dim layer As Layer
Dim cellWidthMM As Double, cellHeightMM As Double, overcutMM As Double
Dim rows As Long, cols As Long
Dim cellWidthDU As Double, cellHeightDU As Double, overcutDU As Double
Dim i As Long, yPos As Double
Dim lastX As Double, lastY As Double
Dim vertTopToBottom As Boolean
Dim xStart As Double, xEnd As Double
Dim firstColIndex As Long
Dim colOffset As Long, jIndex As Long
Dim xPos As Double, yBottom As Double, yTop As Double
Dim s As Shape, gridGroup As Shape, rect As Rect
Dim offsetX As Double, offsetY As Double
Dim allLines As New Collection
Set doc = ActiveDocument
Set pg = doc.ActivePage
Set layer = ActiveLayer
' Ввод параметров
cellWidthMM = Val(InputBox("Введите ширину ячейки (мм):", "Сетка", "30"))
cellHeightMM = Val(InputBox("Введите высоту ячеек (мм):", "Сетка", "20"))
overcutMM = Val(InputBox("Введите overcut (мм):", "Сетка", "2"))
rows = Val(InputBox("Введите количество рядов:", "Сетка", "10"))
cols = Val(InputBox("Введите количество столбцов:", "Сетка", "5"))
If cellWidthMM <= 0 Or cellHeightMM <= 0 Or rows <= 0 Or cols <= 0 Or overcutMM < 0 Then
MsgBox "Все значения должны быть корректными!", vbExclamation
Exit Sub
End If
' Конвертация в единицы документа
cellWidthDU = doc.ToUnits(cellWidthMM, cdrMillimeter)
cellHeightDU = doc.ToUnits(cellHeightMM, cdrMillimeter)
overcutDU = doc.ToUnits(overcutMM, cdrMillimeter)
' --- Горизонтальные линии (змейка) ---
For i = 0 To rows
yPos = i * cellHeightDU ' Считаем от низа страницы вверх
If i Mod 2 = 0 Then
xStart = -overcutDU
xEnd = cols * cellWidthDU + overcutDU
Else
xStart = cols * cellWidthDU + overcutDU
xEnd = -overcutDU
End If
Set s = layer.CreateLineSegment(xStart, yPos, xEnd, yPos)
allLines.Add s
If i = rows Then
lastX = IIf(i Mod 2 = 0, cols * cellWidthDU, 0)
lastY = yPos
End If
Next i
' Определяем индекс первой вертикали
If lastX = 0 Then
firstColIndex = 0
Else
firstColIndex = cols
End If
' --- Вертикальные линии (змейка) ---
vertTopToBottom = True
yBottom = -overcutDU
yTop = rows * cellHeightDU + overcutDU
For colOffset = 0 To cols
If lastX = 0 Then
jIndex = firstColIndex + colOffset
Else
jIndex = firstColIndex - colOffset
End If
If jIndex < 0 Or jIndex > cols Then Exit For
xPos = jIndex * cellWidthDU
If vertTopToBottom Then
Set s = layer.CreateLineSegment(xPos, yBottom, xPos, yTop)
Else
Set s = layer.CreateLineSegment(xPos, yTop, xPos, yBottom)
End If
allLines.Add s
vertTopToBottom = Not vertTopToBottom
Next colOffset
' --- Группируем все линии ---
Dim arr() As Shape
ReDim arr(1 To allLines.Count)
For i = 1 To allLines.Count
Set arr(i) = allLines(i)
Next i
Set gridGroup = layer.Group(arr)
' --- Центрирование относительно страницы ---
Set rect = gridGroup.BoundingBox
offsetX = (pg.SizeWidth / 2) - (rect.Left + rect.Width / 2)
offsetY = (pg.SizeHeight / 2) - (rect.Bottom + rect.Height / 2)
gridGroup.Move offsetX, offsetY
' --- Снять выделение ---
doc.ClearSelection
MsgBox "Сетка готова и отцентрирована по центру страницы!"
End SubБыл бы признателен, если кто-нибудь поделится рабочим решением.
Спасибо.
в этом и прелесть простых алгоритмов, что там логика простая и ломаться нечему.