반응형
- 화이트 밸런스를 눈대중으로 맞추기 어려운 경우에 가끔 사용하려고 제작했다.
- 사진의 각 픽셀을 건너뛰면서 컬러 샘플링을 하고, 지정한 검출 한계(변수: thr)만큼의 회색인 경우 샘플러를 찍어두는 로직이다.
- 사진 크기가 클수록 검출하는 데 오래걸리기 때문에 건너뛰는 픽셀(변수: stepPx)수를 조금씩 변경하면서 찾는 편이 빠르다.
- 중간회색을 찾은 이후에는 Curve 툴로 회색지점(또는 회색이 되어야 하는 지점)을 찍어주어 화이트밸런스를 맞출 수 있다.
VBA Code
Option Explicit
Sub auto_gray_finding()
Dim appRef As Photoshop.Application
Dim docRef As Document
Dim lyrRef As ArtLayer
Dim lyrs As ArtLayers
Dim px_x As Double
Dim px_y As Double
Dim c_R As Double, c_G As Double, c_B As Double
Dim thr As Double
Dim stepPx As Long
Dim pCnt As Long
Set appRef = New Photoshop.Application
Set docRef = appRef.ActiveDocument
Set lyrRef = docRef.ActiveLayer
Set lyrs = docRef.ArtLayers
appRef.Visible = True
appRef.Preferences.RulerUnits = psPixels
appRef.DisplayDialogs = psDisplayNoDialogs
thr = 5 '검출 한계: 컬러샘플로 찍은 범위의 RGB 값의 한도값
stepPx = 100 '150픽셀씩 건너뛰면서 검색(1px 단위로 건너뛰면 너무 오래걸림)
pCnt = 1
Call docRef.ColorSamplers.Add(Array(1, 1))
For px_x = 3 To docRef.Width Step stepPx
For px_y = 3 To docRef.Height Step stepPx
Call docRef.ColorSamplers(pCnt).Move(Array(px_x, px_y)) '컬러샘플러 좌표 이동
With docRef.ColorSamplers(pCnt).Color.RGB '해당 좌표의 RGB값 검출
c_R = Abs(.Red - 128)
c_G = Abs(.Green - 128)
c_B = Abs(.Blue - 128)
End With
If c_R < thr And _
c_G < thr And _
c_B < thr Then
'중간회색 지점을 찾으면
Call docRef.ColorSamplers.Add(Array(px_x, px_y)) '해당 점에서 새로운 마킹 추가
pCnt = pCnt + 1 '샘플러 개수 증가
End If
If pCnt > 5 Then
Exit Sub
End If
Next px_y
Next px_x
Set docRef = Nothing
Set appRef = Nothing
End Sub
매크로 실행 동영상
Copyright (2018) Ruahneuma. All Rights Reserved.
반응형
'VBA Macro > VBA Photoshop' 카테고리의 다른 글
포토샵 피부보정(주파수분리 적절한 가우시안 블러값) (2) | 2024.10.04 |
---|---|
엑셀 VBA로 포토샵 이미지 자르기(불투명 부분 날리기) (0) | 2018.03.07 |
엑셀 VBA를 이용하여 포토샵 이미지 리사이즈 및 저장 (0) | 2018.03.06 |
엑셀 VBA로 포토샵 이미지 크기 변경 (0) | 2018.03.06 |