Цитата LilLoco:
|
Iska, да нужно поверх просто наложить. »
|
LilLoco, для ручного метода объединения можно попробовать так:
читать дальше »
Код:
Option Explicit
Const psPixels = 1
Const psDisplayNoDialogs = 3
Dim strDocument
Dim objPhotoshop
Dim objDocument
Dim objLayerSet
Dim lngPrevRulerUnits
Dim lngPrevDisplayDialogs
Dim i
Dim j
Dim lngStep
Set objPhotoshop = WScript.CreateObject("Photoshop.Application")
objPhotoshop.Visible = True
lngPrevRulerUnits = objPhotoshop.Preferences.RulerUnits
objPhotoshop.Preferences.RulerUnits = psPixels
lngPrevDisplayDialogs = objPhotoshop.DisplayDialogs
objPhotoshop.DisplayDialogs = psDisplayNoDialogs
If objPhotoshop.Documents.Count > 0 Then
Set objDocument = objPhotoshop.ActiveDocument
Else
strDocument = "E:\Песочница\0083\Sample.jpg"
Set objDocument = objPhotoshop.Open(strDocument)
End If
Set objLayerSet = objDocument.LayerSets.Add
objLayerSet.Name = "Сетка"
' Шаг сетки в мм
lngStep = 100 * objDocument.Resolution / 25.4
For i = 0 To objDocument.Width Step lngStep
For j = 0 To objDocument.Height Step lngStep
With objDocument.ArtLayers.Add
.Move objLayerSet, 0
End With
DrawLine objPhotoshop, i, j, i + lngStep, j, 1
With objDocument.ArtLayers.Add
.Move objLayerSet, 0
End With
DrawLine objPhotoshop, i, j, i, j + lngStep, 1
Next
Next
objPhotoshop.Preferences.RulerUnits = lngPrevRulerUnits
objPhotoshop.DisplayDialogs = lngPrevDisplayDialogs
Set objLayerSet = Nothing
Set objDocument = Nothing
Set objPhotoshop = Nothing
WScript.Quit 0
'=============================================================================
'=============================================================================
Sub DrawLine(objApp, x1, y1, x2, y2, width)
Dim objAD_StartPoint
Dim objAD_EndPoint
Dim objAD_Line
Dim objAD_Shape
Set objAD_StartPoint = WScript.CreateObject("Photoshop.ActionDescriptor")
With objAD_StartPoint
.PutUnitDouble objApp.StringIDToTypeID("horizontal"), objApp.StringIDToTypeID("distanceUnit"), x1
.PutUnitDouble objApp.StringIDToTypeID("vertical"), objApp.StringIDToTypeID("distanceUnit"), y1
End With
Set objAD_EndPoint = WScript.CreateObject("Photoshop.ActionDescriptor")
With objAD_EndPoint
.PutUnitDouble objApp.StringIDToTypeID("horizontal"), objApp.StringIDToTypeID("distanceUnit"), x2
.PutUnitDouble objApp.StringIDToTypeID("vertical"), objApp.StringIDToTypeID("distanceUnit"), y2
End With
Set objAD_Line = WScript.CreateObject("Photoshop.ActionDescriptor")
With objAD_Line
.PutObject objApp.StringIDToTypeID("start"), objApp.StringIDToTypeID("paint"), objAD_StartPoint
.PutObject objApp.StringIDToTypeID("end"), objApp.StringIDToTypeID("paint"), objAD_EndPoint
.PutUnitDouble objApp.StringIDToTypeID("width"), objApp.StringIDToTypeID("pixelsUnit"), width
End With
Set objAD_Shape = WScript.CreateObject("Photoshop.ActionDescriptor")
With objAD_Shape
.PutObject objApp.StringIDToTypeID("shape"), objApp.StringIDToTypeID("lineClass"), objAD_Line
.PutBoolean objApp.StringIDToTypeID("antiAlias"), True
End With
objApp.ExecuteAction objApp.StringIDToTypeID("draw"), objAD_Shape, psDisplayNoDialogs
Set objAD_Shape = Nothing
Set objAD_Line = Nothing
Set objAD_EndPoint = Nothing
Set objAD_StartPoint = Nothing
End Sub
'=============================================================================
* работа ведётся с открытым в Photoshop'е документом, при отсутствии такового — с указанным;
* сетка рисуется текущим цветом (просто установите потребный цвет перед запуском скрипта) из горизонтальных и вертикальных линий — рёбер квадратов, каждая линия в отдельном слое (дабы можно было просто удалить слой с линией для объединения двух квадратов);
* сетка рисуется от координаты 0,0 вправо-вниз с шагом:
Код:
' Шаг сетки в 100 мм
lngStep = 100 * objDocument.Resolution / 25.4
* по окончании отрисовки не делается никаких действий по сохранению документа, закрытию Photoshop'а.
Я постарался максимально упростить пример. Код проверялся под Photoshop из CS 2 (другого под рукой не нашлось). Вполне возможно, что в новых версиях что-то поменялось и отвалится, что-то можно сделать проще и т.п.
Цитата LilLoco:
|
Расположение объединенных ячеек известно заранее. »
|
Тогда можно попробовать обойтись более простыми средствами (вопрос только в определении соотношения между мм и пикселями в тех форматах, которые не содержат информацию о dpi).
Как думаете указывать, какие квадраты будут являться объединёнными (или отсутствующие рёбра)?
