VBA Macro/VBA Photoshop

포토샵 피부보정(주파수분리 적절한 가우시안 블러값)

루아흐뉴마 2018. 8. 11. 08:01
반응형

매크로 설명



  • 주파수분리(Frequency Separation) 기법은 피부를 보정하는 다양한 방법 중 하나이다.
  • 특히 거친 피부를 매끄럽게 하면서도 피부 자체의 디테일을 보존하는 데 탁월하다
  • 주파수분리는 크게 두 단계다.
  • 1) 원본사진의 톤과 디테일을 분리한다. (이 과정에서 약간의 가우시안 블러가 들어감)
  • 2) 톤 영역에 대해서만 한 번 더 블러를 먹여서 피부를 보정한다. (여기서 한 번 더 가우시안 블러가 들어감)
  • 이 과정이 꽤나 귀찮기 때문에 보통은 액션(Action)을 만들어두고 사용한다.
  • 다만, '디테일 분리를 위해 적절한 가우시안 블러 사이즈가 얼마인가?'를 고민할 수 있다.
  • 이 때문에 블러 사이즈를 고정시킨 액션을 실행하는게 찝찝하다. (그래서 매크로를 만들었다.)
  • 본인의 경우 얼굴부분의 픽셀 사이즈(가로x세로)에 0.000004를 곱해서 쓴다.
  • 즉 얼굴부분의 사이즈가 100만 픽셀이면 1) 단계에서 가우시안 블러 사이즈를 4 정도 준다. (200만이면? 8 정도 준다.)
  • 0.00으로 시작 하는 저 기괴한 숫자는 본인이 쓰다가 적절한 타협점을 찾은 값이다.
  • 2) 단계에서 적용하는 가우시안 블러 값은 1) 단계에서 적용한 블러 사이즈의 2.5~3배 정도를 주면 나쁘지 않다.
  • 2) 단계에서 값을 너무 크게 줬더라도 Opacity를 줘서 강도를 낮출 수 있기 때문에 민감할 필요는 없다.
  • 영상에서 보는것처럼 매크로를 적용하고 나면 마스크가 하나 생기는데, 여기서 피부 보정이 필요한 부분만 밝혀주면 된다.

실행결과




VBA Code


Option Explicit
Sub freq()
Dim appPhoto As Photoshop.Application 'early bound
Dim docRef As Photoshop.Document
Dim layRef As Photoshop.ArtLayer
Dim lays As Photoshop.ArtLayers
Dim actName As String
Dim blurDeg As Double

blurDeg = InputBox("얼굴의 픽셀수 입력") * 0.000004 '디테일 분리를 위한 가우시안 블러 정도

On Error Resume Next  '에러 검출 off
Set appPhoto = GetObject(, "Photoshop.Application")
If Err.Number > 0 Then  '오류 발생시
  MsgBox "포토샵을 실행하세요", vbOKOnly
  Exit Sub  '매크로 종료
End If
On Error GoTo 0 '에러 검출 on

Set docRef = appPhoto.ActiveDocument
Set layRef = docRef.ActiveLayer
Set lays = docRef.ArtLayers

actName = layRef.Name '복사하기 전 현재 레이어 명칭

layRef.Duplicate '레이어 복사 2회
layRef.Duplicate

Call lays(actName & " copy 2").ApplyGaussianBlur(blurDeg) '두 번째 복사된 레이어에 가우시안 블러 적용

docRef.ActiveLayer = lays(actName & " copy") '첫번째 복사한 레이어 활성화


'여기서부터는 VB ScriptingListener 수행결과를 따름 (개체모델을 찾을 수 없어서)
Dim dialogMode
dialogMode = 3
Dim idAppI
Dim idslct

'하단의 script는 주파수 분리를 수행하는 과정

idAppI = appPhoto.CharIDToTypeID("AppI")
  Dim desc202
  Set desc202 = CreateObject("Photoshop.ActionDescriptor")
  Dim idWith
  idWith = appPhoto.CharIDToTypeID("With")
  Dim desc203
  Set desc203 = CreateObject("Photoshop.ActionDescriptor")
  Dim idT
    idT = appPhoto.CharIDToTypeID("T" & Chr(32) & Chr(32) & Chr(32))
    Dim ref100
    Set ref100 = CreateObject("Photoshop.ActionReference")
    Dim idChnl
    idChnl = appPhoto.CharIDToTypeID("Chnl")
    Dim idRGB
    idRGB = appPhoto.CharIDToTypeID("RGB ")
    Call ref100.PutEnumerated(idChnl, idChnl, idRGB)
    Dim idLyr
    idLyr = appPhoto.CharIDToTypeID("Lyr ")
    Call ref100.PutName(idLyr, actName & " copy 2")
  Call desc203.PutReference(idT, ref100)
  Dim idClcl
  idClcl = appPhoto.CharIDToTypeID("Clcl")
  Dim idClcn
  idClcn = appPhoto.CharIDToTypeID("Clcn")
  Dim idSbtr
  idSbtr = appPhoto.CharIDToTypeID("Sbtr")
  Call desc203.PutEnumerated(idClcl, idClcn, idSbtr)
  Dim idScl
  idScl = appPhoto.CharIDToTypeID("Scl ")
  Call desc203.PutDouble(idScl, 2.00000)
  Dim idOfst
  idOfst = appPhoto.CharIDToTypeID("Ofst")
  Call desc203.PutInteger(idOfst, 128)
  
  idClcl = appPhoto.CharIDToTypeID("Clcl")
  Call desc202.PutObject(idWith, idClcl, desc203)
  Call appPhoto.ExecuteAction(idAppI, desc202, dialogMode)


lays(actName & " copy").BlendMode = Photoshop.psLinearLight '디테일 레이어 Linear Light 적용
docRef.ActiveLayer = lays(actName & " copy 2")  '톤 레이어 선택

Dim idnewPlacedLayer '톤 레이어를 스마트 오브젝트 레이어로 변환
idnewPlacedLayer = appPhoto.StringIDToTypeID("newPlacedLayer")
Call appPhoto.ExecuteAction(idnewPlacedLayer, , dialogMode)

Call lays(actName & " copy 2").ApplyGaussianBlur(blurDeg * 2.7) '가우시안 블러 적용

Set docRef = Nothing
Set appPhoto = Nothing

End Sub




매크로 실행 동영상





 Copyright (2018) Ruahneuma. All Rights Reserved.


반응형