求助写一个CorelDRAW导出图片，四周扩边5mm的GMS插件

何先生

求助写一个CorelDRAW导出图片，扩边5mm的，分辨率200的GMS插件

dlh

咋阔啊？就是加个框？

何先生

dlh 发表于 2025-1-11 13:38
咋阔啊？就是加个框？

是要导出图片的GMS，然后内容要扩边，像图中那样

dlh

何先生 发表于 2025-1-11 13:52
是要导出图片的GMS，然后内容要扩边，像图中那样

这个简单的

何先生

dlh 发表于 2025-1-11 14:01
这个简单的

好的，大神有空帮写一个，

makaka007

直接设置一下页面自动扩5mm就好了,很简单的操作.

何先生

makaka007 发表于 2025-1-11 14:05
直接设置一下页面自动扩5mm就好了,很简单的操作.

不会写GMS, 大神会写的话，帮写一个，导图可以自定义设置路径的

何先生

Public Sub 批量外框()
    ActiveDocument.BeginCommandGroup
    ActiveDocument.Unit = cdrMillimeter
    ActiveDocument.ReferencePoint = cdrCenter
    Dim X As Double, Y As Double, w As Double, h As Double
    Dim s1 As Shape
    Dim s2 As Shape
    Dim pyl As Double
   
    pyl = 5 ' 设置偏移量为5mm
    If ActiveSelection.Shapes.Count <> 5 Then
        For Each s2 In ActiveSelection.Shapes
            s2.GetBoundingBox X, Y, w, h
            Set s1 = ActiveLayer.CreateRectangle(X - pyl, Y - pyl, X + w + pyl, Y + h + pyl)
            s1.Fill.ApplyNoFill ' 保持内部填充为无填充
            ' 设置外框形状的轮廓颜色为白色，以下是具体的设置颜色相关语句（根据不同软件环境可能需调整）
            s1.Outline.SetColor CMYK(0, 0, 0, 0) ' 使用CMYK值设置颜色，这里白色对应CMYK(0, 0, 0, 0)
            s1.Outline.Width = 1 ' 可以根据实际需求设置外框宽度，这里设为1mm，可调整
            s2.AddToSelection
            ActiveSelection.Group
        Next s2
    End If
    ActiveDocument.EndCommandGroup ' 记得添加结束命令组语句，保持操作逻辑完整性
End Sub
   
    ActiveDocument.EndCommandGroup
   
    On Error GoTo ErrorHandler
    Dim d As Document
    Set d = ActiveDocument
    Dim Sh As Shape, shs As Shapes
    Dim Color As String
    Set shs = ActiveSelection.Shapes
   
    dpi = 300
    Color = cdrRGBColorImage

    '// 导出图片精度设置，设置颜色模式
    Dim opt As New StructExportOptions
    With opt
    .ResolutionX = dpi
    .ResolutionY = dpi
    .ImageType = Color
    .Transparent = True
    End With
   
    Dim Path$: Path = CorelScriptTools.GetFolder(d.FilePath)
    '// 批处理导出图片
        Dim i As Double
        i = 1
    For Each Sh In shs
        ActiveDocument.ClearSelection
        Sh.CreateSelection

        ' 导出图片PNG格式
        f = Path & "\" & "p-" & i & ".png"
        d.Export f, cdrPNG, cdrSelection, opt
                i = i + 1
    Next Sh
    Beep
ErrorHandler:

End Sub

有哪个大神帮我 PNG格式改成 JPG的，或者在第一段代码添加的边框加个白底色也可以，默认路径设置导出在桌面文件夹

jiangyu

把.Transparent = True改成.Transparent = False可以关闭透明背景，变成白色底色。d.Export f, cdrPNG, cdrSelection, opt导出的这里把cdrPNG前面的逗号重新打一下会出来格式选择。f = Path & "\" & "p-" & i & ".png"文件名这里.png需要修改成格式所对应的后缀名。

何先生

jiangyu 发表于 2025-1-15 13:31
把.Transparent = True改成.Transparent = False可以关闭透明背景，变成白色底色。d.Export f, cdrPNG, cdr ...

好的 谢了，这个代码不用了，直接用现有的导出插件方便些，这个老是自动把文件加个边框也不方便