Coreldraw VBA - 根据辅助线自动设置规矩线（包装设计）

'辅助线转规矩线
Sub GuiAll2Line() '************************
    Dim HGui() As Double '水平
    Dim VGui() As Double '垂直
    Dim Doc As VGCore.Document
    Dim Sh As VGCore.Shape
    Dim L As Double, T As Double, R As Double, B As Double
    Dim mmH As Long, mmV As Long
    Dim Bleeding As Integer, Bi As Integer '出血
    Set Doc = VGCore.ActiveDocument
    Bi = MsgBox("请确定出血距离是否为3mm，点击'否'则为5mm，点击'取消'则出血为0mm。", 3)
        Select Case Bi
        Case 6: Bleeding = 3
        Case 7: Bleeding = 5
        Case 2: Bleeding = 0
    End Select
    Optimization = True
    EventsEnabled = False
    Doc.SaveSettings
    Doc.PreserveSelection = False
    
    'Doc.ActiveWindow.Refresh() = (False)
    Doc.Unit = cdrMillimeter
    '----------------------------------------------
    ReDim HGui(Doc.MasterPage.AllLayers("辅助线").Shapes.Count)
    ReDim VGui(Doc.MasterPage.AllLayers("辅助线").Shapes.Count)
    '----------------------------------------------
    L = 10000: T = -10000: R = -10000: B = 10000
    mmV = 0: mmH = 0
    '----------------------------------------------
    For Each Sh In Doc.MasterPage.AllLayers("辅助线").Shapes
        If Sh.Type = cdrGuidelineShape Then
            If Sh.Guide.Type = cdrHorizontalGuide Then '水平
                HGui(mmH) = Sh.Guide.CenterY
                If T < HGui(mmH) Then T = HGui(mmH)
                If B > HGui(mmH) Then B = HGui(mmH)
                mmH = mmH + 1
                
            ElseIf Sh.Guide.Type = cdrVerticalGuide Then '垂直
                VGui(mmV) = Sh.Guide.CenterX
                If L > VGui(mmV) Then L = VGui(mmV)
                If R < VGui(mmV) Then R = VGui(mmV)
                mmV = mmV + 1
            End If
        End If
    Next
    '----------------------------------------------
    If mmH < 2 And mmV < 2 Then Exit Sub
    '----------------------------------------------
    ReDim Preserve HGui(mmH - 1)
    ReDim Preserve VGui(mmV - 1)
    If Bleeding > 0 Then
        T = T + Bleeding
        L = L - Bleeding
        R = R + Bleeding
        B = B - Bleeding
    End If
    '----------------------------------------------
    Dim I As Long
    'Dim Sh As Shape
    Dim Lay As VGCore.Layer
    Set Lay = Ruleline(Doc, "规矩线")
    '----------------------------------------------
       Set Sh = Lay.CreateLineSegment(L, T, L, T + 5)
       Sh.Outline.Color.RGBAssign 0, 0, 0
       Set Sh = Lay.CreateLineSegment(R, B, R, B - 5)
       Sh.Outline.Color.RGBAssign 0, 0, 0
 
       Set Sh = Lay.CreateLineSegment(L, T, L - 5, T)
       Sh.Outline.Color.RGBAssign 0, 0, 0
       Set Sh = Lay.CreateLineSegment(R, B, R + 5, B)
       Sh.Outline.Color.RGBAssign 0, 0, 0
       
       Set Sh = Lay.CreateLineSegment(R, T, R, T + 5)
       Sh.Outline.Color.RGBAssign 0, 0, 0
       Set Sh = Lay.CreateLineSegment(L, B, L, B - 5)
       Sh.Outline.Color.RGBAssign 0, 0, 0
 
       Set Sh = Lay.CreateLineSegment(L, B, L - 5, B)
       Sh.Outline.Color.RGBAssign 0, 0, 0
       Set Sh = Lay.CreateLineSegment(R, T, R + 5, T)
       Sh.Outline.Color.RGBAssign 0, 0, 0
    '----------------------------------------------
    For I = 0 To UBound(VGui) '垂直
       Set Sh = Lay.CreateLineSegment(VGui(I), T, VGui(I), T + 5)
       Sh.Outline.Color.RGBAssign 0, 0, 0
       Set Sh = Lay.CreateLineSegment(VGui(I), B, VGui(I), B - 5)
       Sh.Outline.Color.RGBAssign 0, 0, 0
    Next
    '----------------------------------------------
    For I = 0 To UBound(HGui) '水平
       Set Sh = Lay.CreateLineSegment(L, HGui(I), L - 5, HGui(I))
       Sh.Outline.Color.RGBAssign 0, 0, 0
       Set Sh = Lay.CreateLineSegment(R, HGui(I), R + 5, HGui(I))
       Sh.Outline.Color.RGBAssign 0, 0, 0
    Next
    '----------------------------------------------

   ' Doc.ActiveWindow.Refresh() = (True)
   Set Sh = Lay.CreateArtisticText(L, T, "C", , , "微软雅黑", 14.3, , , , cdrLeftAlignment)
   Sh.Fill.UniformColor.CMYKAssign 100, 0, 0, 0
   
   Set Sh = Lay.CreateArtisticText(L + 5, T, "M", , , "微软雅黑", 14.3, , , , cdrLeftAlignment)
   Sh.Fill.UniformColor.CMYKAssign 0, 100, 0, 0
   
   Set Sh = Lay.CreateArtisticText(L + 10, T, "Y", , , "微软雅黑", 14.3, , , , cdrLeftAlignment)
   Sh.Fill.UniformColor.CMYKAssign 0, 0, 100, 0
   
   Set Sh = Lay.CreateArtisticText(L + 15, T, "K", , , "微软雅黑", 14.3, , , , cdrLeftAlignment)
   Sh.Fill.UniformColor.CMYKAssign 0, 0, 0, 100
   
   Set Sh = Lay.CreateArtisticText(L + 20, T, Left(Doc.Name, Len(Doc.Name) - 4) & "  版心:" & Int(R - L + 0.5) & "×" & Int(T - B - 0.5) & "mm", , , "微软雅黑", 14.3, , , , cdrLeftAlignment)
   Sh.Fill.UniformColor.RGBAssign 0, 0, 0
   '咬口位置不正确，注意手动调整
   Set Sh = Lay.CreateArtisticText(R \ 2, B - 5, "咬口", , , "微软雅黑", 14.3, , , , cdrCenterAlignment)
   Sh.Fill.UniformColor.RGBAssign 0, 0, 0
   
   
   Doc.PreserveSelection = True
   Doc.RestoreSettings
   EventsEnabled = True
   Optimization = False
   Doc.ActiveWindow.Refresh
End Sub