반응형
- 화이트 밸런스를 눈대중으로 맞추기 어려운 경우에 가끔 사용하려고 제작했다.
- 사진의 각 픽셀을 건너뛰면서 컬러 샘플링을 하고, 지정한 검출 한계(변수: 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
매크로 실행 동영상

반응형
'VBA Macro > VBA Photoshop' 카테고리의 다른 글
포토샵 피부보정(주파수분리 적절한 가우시안 블러값) (2) | 2024.10.04 |
---|---|
엑셀 VBA로 포토샵 이미지 자르기(불투명 부분 날리기) (0) | 2018.03.07 |
엑셀 VBA를 이용하여 포토샵 이미지 리사이즈 및 저장 (0) | 2018.03.06 |
엑셀 VBA로 포토샵 이미지 크기 변경 (0) | 2018.03.06 |