반응형

매크로 설명
- 주파수분리(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
매크로 실행 동영상

반응형
'VBA Macro > VBA Photoshop' 카테고리의 다른 글
사진 속 중간회색 찾기(화이트밸런스 맞추기) 매크로 (0) | 2018.03.12 |
---|---|
엑셀 VBA로 포토샵 이미지 자르기(불투명 부분 날리기) (0) | 2018.03.07 |
엑셀 VBA를 이용하여 포토샵 이미지 리사이즈 및 저장 (0) | 2018.03.06 |
엑셀 VBA로 포토샵 이미지 크기 변경 (0) | 2018.03.06 |