VBA Macro/VBA Photoshop

사진 속 중간회색 찾기(화이트밸런스 맞추기) 매크로

루아흐뉴마 2018. 3. 12. 14:44
반응형
  • 화이트 밸런스를 눈대중으로 맞추기 어려운 경우에 가끔 사용하려고 제작했다.
  • 사진의 각 픽셀을 건너뛰면서 컬러 샘플링을 하고, 지정한 검출 한계(변수: 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.

반응형