圆角插口和翅膀的代码

建立圆角矩形函数 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