도형(drawing)의 종류에 따라 도형이 가지고 있는 꼭지점의 위치 정보를 알아내는 방법이 다릅니다. 꼭지점의 정보를 알아내기 위해서는 우선 모든 도형을 자유형(msoFreedom), 즉 polyline 형태의 도형으로 변환시켜야 합니다.
한가지 방법으로 변환시킬 수도 있겠습니다만, 도형에 맞게 방법을 달리 하도록 함수를 작성하였으며, 자세한 방법은 함수의 주석으로 설명을 드리겠습니다.
아래와 같이 생성된 도형은 원본과 모양은 똑같으나, 선이나 채우기 특성은 달라집니다. 필요하다면 모든 작업을 완료한 후, 원본의 속성을 복사하도록 합니다.
'------------------------------------
Function Sh_ConvAutoShape(iSh As Shape, Optional iDelOrigin As Boolean = False) As Shape
Dim tSlide As Slide, tSL As ShapeRange, tSh As Shape, tSh2 As Shape, tNode As ShapeNode, tIsCurve As Boolean
Dim tPos() As Single, tX(1 To 2) As Single, tY(1 To 2) As Single, tRot As Single, tVal As Single
Set tSlide = ActiveSlide
Dim tSlide As Slide, tSL As ShapeRange, tSh As Shape, tSh2 As Shape, tNode As ShapeNode, tIsCurve As Boolean
Dim tPos() As Single, tX(1 To 2) As Single, tY(1 To 2) As Single, tRot As Single, tVal As Single
Set tSlide = ActiveSlide
Select Case iSh.Type
Case msoAutoShape
Case msoAutoShape
'AutoShape인 경우, 모든 도형이 닫힌 형태의 도형입니다. 자유형으로 변환시키기 위해서는 1개의 node만 직선형에서 곡선형으로 바꿔주면 자유형으로 바뀝니다. 그반대로 곡선형 node를 직선형 node로 바꿔주어도 자유형으로 바뀌지만 모양이 유지되지 않습니다. 따라서, 직선형 node만 곡선으로 바꿔줍니다.
Set tSh = Sh_Copy(iSh)
i = 0: tIsCurve = True
For i = 1 to tSh.Nodes.Count
i = i + 1
If tSh.Nodes(i).SegmentType = msoSegmentLine Then
tSh.Nodes.SetSegmentType i, msoSegmentCurve
tIsCurve = False
End If
Next
Set tSh = Sh_Copy(iSh)
i = 0: tIsCurve = True
For i = 1 to tSh.Nodes.Count
i = i + 1
If tSh.Nodes(i).SegmentType = msoSegmentLine Then
tSh.Nodes.SetSegmentType i, msoSegmentCurve
tIsCurve = False
End If
Next
'만약 원과 같이 모든 node가 곡선형인 경우, 직선형 node를 포함하지 않기 때문에 이런 도형은 아래와 같이, 해당 도형을 복제해서 병합해줍니다.
If tIsCurve Then
Set tSh2 = Sh_Copy(tSh)
Set tSL = tSlide.Shapes.Range(Array(tSh.Name, tSh2.Name))
tSL.MergeShapes msoMergeUnion
Set tSh = tSlide.Shapes(tSlide.Shapes.Count)
End If
If tIsCurve Then
Set tSh2 = Sh_Copy(tSh)
Set tSL = tSlide.Shapes.Range(Array(tSh.Name, tSh2.Name))
tSL.MergeShapes msoMergeUnion
Set tSh = tSlide.Shapes(tSlide.Shapes.Count)
End If
'입력해준 도형을 지우고 자유형만 남기고 싶다면 원본은 삭제합니다.
If iDelOrigin Then iSh.Delete
If iDelOrigin Then iSh.Delete
Case msoFreeform
'자유형이 입력되면 아무것도 하지 않습니다. 다만 다른 형태의 도형인 경우와 맞추기 위해 , 원본을 남기도록 한다면, 1개를 더 복제해 줍니다.
If iDelOrigin Then Set tSh = iSh Else Set tSh = Sh_Copy(iSh)
If iDelOrigin Then Set tSh = iSh Else Set tSh = Sh_Copy(iSh)
Case msoLine
'Line인 경우, 직선형과 나머지(곡선형 또는 꺾은선 형태 등)를 구분합니다. 그림을 그리다보면 개체를 연결하는 곡선보다는 직선을 주로 많이 사용하게 되는데, 직선인 경우에는 아래와 같이 생성해줍니다.
Select Case iSh.ConnectorFormat.Type
Case msoConnectorStraight
'직선을 생성한 후 회전된 경우가 있기 때문에 원본을 1개 복사해줍니다. 회전하지 않은 직선 상태로 되돌린 후, 좌측 상단, 우측 하단의 위치를 구해줍니다. 이때, 좌측 상단에서 우측 하단으로 향하는 직선이 기준이 됩니다.
Select Case iSh.ConnectorFormat.Type
Case msoConnectorStraight
'직선을 생성한 후 회전된 경우가 있기 때문에 원본을 1개 복사해줍니다. 회전하지 않은 직선 상태로 되돌린 후, 좌측 상단, 우측 하단의 위치를 구해줍니다. 이때, 좌측 상단에서 우측 하단으로 향하는 직선이 기준이 됩니다.
Set tSh = Sh_Copy(iSh)
tSh.Rotation = 0
With tSh
tX(1) = tSh.Left: tX(2) = tSh.Left + tSh.Width: tY(1) = tSh.Top: tY(2) = tSh.Top + tSh.Height
tSh.Rotation = 0
With tSh
tX(1) = tSh.Left: tX(2) = tSh.Left + tSh.Width: tY(1) = tSh.Top: tY(2) = tSh.Top + tSh.Height
'만약, 좌측 하단에서 우측 상단으로 향하는 직선이라면, 도형은 상하 방향으로 flip된 형태입니다. 따라서, 상/하 좌표를 바꿔줍니다.
If iSh.VerticalFlip Then tVal = tY(1): tY(1) = tY(2): tY(2) = tVal
'마찬가지로, 우측에서 좌측으로 향하는 화살표라면 좌우 방향으로 flip된 형태의 속성을 가집니다.
If iSh.HorizontalFlip Then tVal = tX(1): tX(1) = tX(2): tX(2) = tVal
If iSh.HorizontalFlip Then tVal = tX(1): tX(1) = tX(2): tX(2) = tVal
'직선의 속성을 확인했다면 복제된 직선은 삭제를 합니다.
.Delete
End With
'직선의 시작점과 끝점을 확인했으므로, AddPolyLine method를 이용하여, 직선을 생성해준 후, 원본 회전 각도만큼 회전시켜주면, msoLine으로 생성된 직선을 자유형으로 변환할 수 있습니다.
ReDim tPos(1 To 2, 1 To 2)
tPos(1, 1) = tX(1): tPos(1, 2) = tY(1)
tPos(2, 1) = tX(2): tPos(2, 2) = tY(2)
Set tSh = tSlide.Shapes.AddPolyline(tPos)
tSh.Rotation = iSh.Rotation
ReDim tPos(1 To 2, 1 To 2)
tPos(1, 1) = tX(1): tPos(1, 2) = tY(1)
tPos(2, 1) = tX(2): tPos(2, 2) = tY(2)
Set tSh = tSlide.Shapes.AddPolyline(tPos)
tSh.Rotation = iSh.Rotation
Case Else
'msoLine 중 곡선형태 또는 꺾은선형태라면, 꼭지점 위치를 구할 수 없습니다. 따라서, 아래와 같이, EMF 형식의 그림으로 변환한 후, 다시 Shape으로 다시 변환하는 방식으로 자유형으로 변환합니다. 이를 위해서는 이미 만들어둔 함수를 활용할 수 있습니다.
'msoLine 중 곡선형태 또는 꺾은선형태라면, 꼭지점 위치를 구할 수 없습니다. 따라서, 아래와 같이, EMF 형식의 그림으로 변환한 후, 다시 Shape으로 다시 변환하는 방식으로 자유형으로 변환합니다. 이를 위해서는 이미 만들어둔 함수를 활용할 수 있습니다.
Set tSh2 = Sh_Copy(iSh)
With tSh2
With tSh2
'만약, msoLine이 점선 형태라면, EMF로 변환할 때, 각 점들이 각각의 선으로 변환되기 때문에 1개의 선이 아니라 여러 개의 선으로 바뀝니다. 따라서, DashStyle을 점선이 아닌 직선으로 바꿔줍니다. 또한 시작 또는 끝점이 화살표나 원형점 등으로 지정되어있다면 다른 도형으로 변환되기 때문에 이러한 특성도 모두 해제해서 선만 남겨두며, 회전이 되어있다면 회전각도 초기화시킵니다.
.Line.DashStyle = msoLineSolid
.Line.BeginArrowheadStyle = msoArrowheadNone
.Line.EndArrowheadStyle = msoArrowheadNone
tRot = .Rotation
.Rotation = 0
tX(1) = .Width: tX(2) = .Height
End With
.Line.DashStyle = msoLineSolid
.Line.BeginArrowheadStyle = msoArrowheadNone
.Line.EndArrowheadStyle = msoArrowheadNone
tRot = .Rotation
.Rotation = 0
tX(1) = .Width: tX(2) = .Height
End With
'EMF로 변환했다가 다시 Shape으로 변환하게 되면, 선만 남게 됩니다. 그러나, EMF로 변환하면서 삽입된 frame으로 인해 도형의 크기가 원본과 약간 차이가 나게 됩니다. 따라서, 최종 변환된 도형을 원본과 크기와 회전 속성을 원본과 동일하게 맞춰줍니다.
Set tSh = Convert2Pic(tSh2, ppPasteEnhancedMetafile, 0, 0)
Set tSh = ConvertEMF2Shape(tSh, True, 0, 0)
tSh2.Delete
With tSh
.LockAspectRatio = msoFalse
.Width = tX(1): .Height = tX(2)
.Rotation = tRot
.Left = iSh.Left: .Top = iSh.Top
End With
Set tSh = Convert2Pic(tSh2, ppPasteEnhancedMetafile, 0, 0)
Set tSh = ConvertEMF2Shape(tSh, True, 0, 0)
tSh2.Delete
With tSh
.LockAspectRatio = msoFalse
.Width = tX(1): .Height = tX(2)
.Rotation = tRot
.Left = iSh.Left: .Top = iSh.Top
End With
End Select
If iDelOrigin Then iSh.Delete
Case msoTextBox
'텍스트 박스는 텍스트 상자의 위치, 크기 및 회전 정보로부터 4각형의 좌표를 생성한 후 AddPolyline으로 4각형을 생성하고, 회전 속성을 입력해주면 됩니다.
ReDim tPos(1 To 5, 1 To 2)
tX(1) = iSh.Left: tX(2) = iSh.Left + iSh.Width: tY(1) = iSh.Top: tY(2) = iSh.Top + iSh.Height
tPos(1, 1) = tX(1): tPos(1, 2) = tY(1)
tPos(2, 1) = tX(2): tPos(2, 2) = tY(1)
tPos(3, 1) = tX(2): tPos(3, 2) = tY(2)
tPos(4, 1) = tX(1): tPos(4, 2) = tY(2)
tPos(5, 1) = tX(1): tPos(5, 2) = tY(1)
Set tSh = tSlide.Shapes.AddPolyline(tPos)
tSh.Rotation = iSh.Rotation
If iDelOrigin Then iSh.Delete
End Select
Set Sh_ConvAutoShape = tSh
Erase tPos, tX, tY
End Function
ReDim tPos(1 To 5, 1 To 2)
tX(1) = iSh.Left: tX(2) = iSh.Left + iSh.Width: tY(1) = iSh.Top: tY(2) = iSh.Top + iSh.Height
tPos(1, 1) = tX(1): tPos(1, 2) = tY(1)
tPos(2, 1) = tX(2): tPos(2, 2) = tY(1)
tPos(3, 1) = tX(2): tPos(3, 2) = tY(2)
tPos(4, 1) = tX(1): tPos(4, 2) = tY(2)
tPos(5, 1) = tX(1): tPos(5, 2) = tY(1)
Set tSh = tSlide.Shapes.AddPolyline(tPos)
tSh.Rotation = iSh.Rotation
If iDelOrigin Then iSh.Delete
End Select
Set Sh_ConvAutoShape = tSh
Erase tPos, tX, tY
End Function
댓글 없음:
댓글 쓰기
의견이나 질문이 있으신 분은 언제든지 댓글을 달아주세요~