[Iska]

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 (другого под рукой не нашлось). Вполне возможно, что в новых версиях что-то поменялось и отвалится, что-то можно сделать проще и т.п.

Расположение объединенных ячеек известно заранее. »

Тогда можно попробовать обойтись более простыми средствами (вопрос только в определении соотношения между мм и пикселями в тех форматах, которые не содержат информацию о dpi).

Как думаете указывать, какие квадраты будут являться объединёнными (или отсутствующие рёбра)?