landboy 发表于 2023-8-6 11:37:40

CorelDRAW VBA 简单代码实现绘制盒子


前两天在本论坛看到网友，问怎么绘制如下图简单的封套盒子。
所以有了思路，就动手写了代码




代码中的公式，不用初中知识应该就可以理解的。
就是计算几个矩形多大，绘制4条线，把线移动到正确的位置
Public Function Simple_box_one()
ActiveDocument.Unit = cdrMillimeter
l = 100: w = 50: h = 70: b = 15
boxL = 2 * l + 2 * w + b
boxH = h
l1x = w
l2x = w + l
l3x = 2 * w + l
l4x = 2 * (w + l)

Set Rect = ActiveLayer.CreateRectangle(0, 0, boxL, boxH)
Set sl1 = DrawLine(l1x, 0, l1x, h)
Set sl2 = DrawLine(l2x, 0, l2x, h)
Set sl3 = DrawLine(l3x, 0, l3x, h)
Set sl4 = DrawLine(l4x, 0, l4x, h)
End Function




Public Function Simple_box_two()
ActiveDocument.Unit = cdrMillimeter
l = 100: w = 50: h = 70: b = 15
boxL = 2 * l + 2 * w + b: boxH = h
l1x = w: l2x = w + l: l3x = 2 * w + l: l4x = 2 * (w + l)

Set mainRect = ActiveLayer.CreateRectangle(0, 0, boxL, boxH)

Set topRect = ActiveLayer.CreateRectangle(0, 0, l, w)
topRect.Move l1x, h
Set bottomRect = ActiveLayer.CreateRectangle(0, 0, l, w)
bottomRect.Move l3x, -w

Set sl1 = DrawLine(l1x, 0, l1x, h)
Set sl2 = DrawLine(l2x, 0, l2x, h)
Set sl3 = DrawLine(l3x, 0, l3x, h)
Set sl4 = DrawLine(l4x, 0, l4x, h)
End Function绘制线条的代码写成函数调用，可以设置颜色或者粗细
'// 画一条线，设置轮廓色 M100
Private Function DrawLine(X1, Y1, X2, Y2) As Shape
Set DrawLine = ActiveLayer.CreateLineSegment(X1, Y1, X2, Y2)
DrawLine.Outline.SetProperties Color:=CreateCMYKColor(0, 100, 0, 0)
End Function

landboy 发表于 2023-8-7 08:35:26

本帖最后由 landboy 于 2023-8-7 08:44 编辑

圆角插口和翅膀的代码


建立圆角矩形函数 CreateRectangle(0, 0, l, b, 50, 50) ，第5-6参数，指定上2圆角的系数

翅膀是个自定义多节点曲线，先用矩形函数，绘制一个临时物件s 确定范围大小

然后定义 DrawWing(s As Shape) 函数来手工绘制，如图

sp.AppendLineSegment 4, y - 2.5'// 绘制直线
sp.AppendCurveSegment2 6.5, y, 4.1, y - 1.25, 5.1, y'// 绘制曲线







下面是绘制整个盒子完整的代码

Public Function Simple_box_three()
ActiveDocument.Unit = cdrMillimeter
Dim sr As New ShapeRange, wing As New ShapeRange
Dim sh As Shape
l = 100: w = 50: h = 70: b = 15
boxL = 2 * l + 2 * w + b: boxH = h
l1x = w: l2x = w + l: l3x = 2 * w + l: l4x = 2 * (w + l)

'// 绘制主体上下盖矩形
Set mainRect = ActiveLayer.CreateRectangle(0, 0, boxL, boxH)
Set topRect = ActiveLayer.CreateRectangle(0, 0, l, w)
topRect.Move l1x, h
Set bottomRect = ActiveLayer.CreateRectangle(0, 0, l, w)
bottomRect.Move l3x, -w

'// 绘制Box 圆角矩形插口
Set top_RoundRect = ActiveLayer.CreateRectangle(0, 0, l, b, 50, 50)
top_RoundRect.Move l1x, h + w
Set bottom_RoundRect = ActiveLayer.CreateRectangle(0, 0, l, b, 0, 0, 50, 50)
bottom_RoundRect.Move l3x, -w - b
   
'// 绘制box 四个翅膀
Set sh = DrawWing(ActiveLayer.CreateRectangle(0, 0, w, (w + b) / 2 - 2))
wing.Add sh.Duplicate(0, h)
wing.Add sh.Duplicate(l2x, h)
wing.Add sh.Duplicate(0, -sh.SizeHeight)
wing.Add sh.Duplicate(l2x, -sh.SizeHeight)
wing(2).Flip cdrFlipHorizontal
wing(3).Flip cdrFlipVertical
wing(4).Rotate 180

'// 添加到物件组，设置轮廓色 C100
sr.Add mainRect: sr.Add topRect: sr.Add bottomRect
sr.Add top_RoundRect: sr.Add bottom_RoundRect
sr.AddRange wing: sh.Delete
sr.SetOutlineProperties Color:=CreateCMYKColor(100, 0, 0, 0)

'// 绘制尺寸刀痕线
Set sl1 = DrawLine(l1x, 0, l1x, h)
Set sl2 = DrawLine(l2x, 0, l2x, h)
Set sl3 = DrawLine(l3x, 0, l3x, h)
Set sl4 = DrawLine(l4x, 0, l4x, h)

'// 盒子box 群组
sr.Add sl1: sr.Add sl2: sr.Add sl3: sr.Add sl4
sr.CreateSelection: sr.Group

End Function

'// 画一条线，设置轮廓色 M100
Private Function DrawLine(X1, Y1, X2, Y2) As Shape
Set DrawLine = ActiveLayer.CreateLineSegment(X1, Y1, X2, Y2)
DrawLine.Outline.SetProperties Color:=CreateCMYKColor(0, 100, 0, 0)
End Function


Private Function DrawWing(s As Shape) As Shape
    Dim sp As SubPath, crv As Curve
    Dim x As Double, y As Double
    x = s.SizeWidth: y = s.SizeHeight
    s.Delete
   
    '// 绘制 Box 翅膀 Wing
    Set crv = Application.CreateCurve(ActiveDocument)
    Set sp = crv.CreateSubPath(0, 0)
    sp.AppendLineSegment 0, 4
    sp.AppendLineSegment 2, 6
    sp.AppendLineSegment 4, y - 2.5
    sp.AppendCurveSegment2 6.5, y, 4.1, y - 1.25, 5.1, y
    sp.AppendLineSegment x - 2, y
    sp.AppendLineSegment x - 2, 3
    sp.AppendLineSegment x, 0
   
    sp.Closed = True
    Set DrawWing = ActiveLayer.CreateCurve(crv)
End Function
最后在窗口空间中添加一个图片当按钮

Private Sub MakeBox_Click()
box.Simple_box_three
End Sub


stehong 发表于 2023-8-6 11:54:44

学习是好的 应用就没必要了 因为优秀的很多
有空是不是可以研究下这种

jiangyu 发表于 2023-8-6 18:52:50

stehong 发表于 2023-8-6 11:54
学习是好的 应用就没必要了 因为优秀的很多
有空是不是可以研究下这种

这种应该去找做刀模的人做吧，这边大多是做平面设计的，应该不会有人知道做刀模的施工参数。只是照猫画虎的，画出来该加的地方没加，该减的地方没减，那不是无用功了。

那朵SONG 发表于 2023-8-6 18:59:15

landboy 发表于 2023-8-7 08:46:30

stehong 发表于 2023-8-6 11:54
学习是好的 应用就没必要了 因为优秀的很多
有空是不是可以研究下这种

所以， 你可以参考 这个，
制作你想要的盒子插件https://www.52cnp.com/data/attachment/forum/202308/07/084335e4qfblr4rqpr9cq0.png

stehong 发表于 2023-8-7 08:57:49

jiangyu 发表于 2023-8-6 18:52
这种应该去找做刀模的人做吧，这边大多是做平面设计的，应该不会有人知道做刀模的施工参数。只是照猫画虎 ...

一般都是比画个尺寸样式出来再交给做刀模的做
页: [1]
查看完整版本: CorelDRAW VBA 简单代码实现绘制盒子