|
@@ -1,9 +1,175 @@
|
|
|
Attribute VB_Name = "box"
|
|
|
-Public Function Simple_box_three()
|
|
|
+Public Function Simple_box_five(Optional ByVal l As Double, Optional ByVal w As Double, Optional ByVal h As Double, Optional ByVal b As Double = 15)
|
|
|
+ Dim sr As New ShapeRange, wing As New ShapeRange, BottomWing As ShapeRange
|
|
|
+ Dim sh As Shape
|
|
|
+ l1x = w: l2x = w + l: l3x = 2 * w + l: l4x = 2 * (w + l)
|
|
|
+
|
|
|
+ '// 绘制主体上下盖矩形
|
|
|
+ Set mainRect_aw = ActiveLayer.CreateRectangle(0, 0, w, h)
|
|
|
+ Set mainRect_al = ActiveLayer.CreateRectangle(0, 0, l, h)
|
|
|
+ mainRect_al.Move l1x, 0
|
|
|
+ Set mainRect_bw = ActiveLayer.CreateRectangle(0, 0, w, h)
|
|
|
+ mainRect_bw.Move l2x, 0
|
|
|
+ Set mainRect_bl = ActiveLayer.CreateRectangle(0, 0, l, h)
|
|
|
+ mainRect_bl.Move l3x, 0
|
|
|
+
|
|
|
+ Set topRect = ActiveLayer.CreateRectangle(0, 0, l, w)
|
|
|
+ topRect.Move l1x, h
|
|
|
+
|
|
|
+ '// 绘制Box 圆角矩形插口
|
|
|
+ Set top_RoundRect = ActiveLayer.CreateRectangle(0, 0, l, b, 75, 75)
|
|
|
+ top_RoundRect.Move l1x, h + w
|
|
|
+ Set Bond = DrawBond(b, h, l4x, 0)
|
|
|
+
|
|
|
+ '// 绘制box 2个翅膀
|
|
|
+ Set sh = DrawWing(w, (w + b) / 2 - 2)
|
|
|
+ wing.Add sh.Duplicate(0, h)
|
|
|
+ wing.Add sh.Duplicate(l2x, h)
|
|
|
+ wing(2).Flip cdrFlipHorizontal
|
|
|
+
|
|
|
+ '// 绘制 Box 底下翅膀 BottomWing
|
|
|
+ Set BottomWing = DrawBottomWing(l, w, b)
|
|
|
+
|
|
|
+ '// 添加到物件组,设置轮廓色 C100
|
|
|
+ sr.Add mainRect_aw: sr.Add mainRect_al: sr.Add mainRect_bw: sr.Add mainRect_bl
|
|
|
+ sr.Add topRect: sr.Add Bond: sr.Add top_RoundRect
|
|
|
+ sr.AddRange BottomWing
|
|
|
+ sr.AddRange wing: sh.Delete
|
|
|
+ sr.SetOutlineProperties Color:=CreateCMYKColor(100, 0, 0, 0)
|
|
|
+
|
|
|
+ sr.CreateSelection: sr.Group
|
|
|
+
|
|
|
+End Function
|
|
|
+
|
|
|
+
|
|
|
+Private Function DrawBottomWing(ByVal l As Double, ByVal w As Double, ByVal b As Double) As ShapeRange
|
|
|
+ Dim sr As New ShapeRange, s As Shape
|
|
|
+ Dim sp As SubPath, crv(3) As Curve
|
|
|
+
|
|
|
+ '// 绘制 Box 底下翅膀 BottomWing
|
|
|
+ Set crv(1) = Application.CreateCurve(ActiveDocument)
|
|
|
+ Set sp = crv(1).CreateSubPath(0, 0)
|
|
|
+ sp.AppendLineSegment w / 2, w * 0.275
|
|
|
+ sp.AppendLineSegment w / 2, w / 2 - 5
|
|
|
+ sp.AppendCurveSegment2 w / 2 + 5, w / 2, w / 2, w / 2 - 2.5, w / 2 + 2.5, w / 2
|
|
|
+ sp.AppendLineSegment w, w / 2
|
|
|
+ sp.AppendLineSegment w, 0
|
|
|
+ sp.Closed = True
|
|
|
+ sr.Add ActiveLayer.CreateCurve(crv(1))
|
|
|
+
|
|
|
+ Set crv(2) = Application.CreateCurve(ActiveDocument)
|
|
|
+ Set sp = crv(2).CreateSubPath(0, 0)
|
|
|
+ sp.AppendLineSegment w / 2, w * 0.275
|
|
|
+ sp.AppendLineSegment w / 2 + b - 5, w * 0.275
|
|
|
+ sp.AppendCurveSegment2 w / 2 + b, w * 0.275 + 5, w / 2 + b - 2.5, w * 0.275, w / 2 + b, w * 0.275 + 2.5
|
|
|
+ sp.AppendLineSegment w / 2 + b, l - w * 0.275 - 5
|
|
|
+ sp.AppendCurveSegment2 w / 2 + b - 5, l - w * 0.275, w / 2 + b, l - w * 0.275 - 2.5, w / 2 + b - 2.5, l - w * 0.275
|
|
|
+
|
|
|
+ sp.AppendLineSegment w / 2, l - w * 0.275
|
|
|
+ sp.AppendLineSegment 0, l
|
|
|
+ sp.Closed = True
|
|
|
+ sr.Add ActiveLayer.CreateCurve(crv(2))
|
|
|
+
|
|
|
+ Set crv(3) = Application.CreateCurve(ActiveDocument)
|
|
|
+ Set sp = crv(3).CreateSubPath(0, 0)
|
|
|
+ sp.AppendLineSegment 0, l
|
|
|
+ sp.AppendLineSegment w / 2 + b, l
|
|
|
+ sp.AppendLineSegment w / 2 + b, l - w * 0.275 + 5
|
|
|
+ sp.AppendCurveSegment2 w / 2 + b - 5, l - w * 0.275, w / 2 + b, l - w * 0.275 + 2.5, w / 2 + b - 2.5, l - w * 0.275
|
|
|
+ sp.AppendLineSegment w / 2, l - w * 0.275
|
|
|
+ sp.AppendLineSegment w / 2, w * 0.275
|
|
|
+ sp.AppendLineSegment w / 2 + b - 5, w * 0.275
|
|
|
+ sp.AppendCurveSegment2 w / 2 + b, w * 0.275 - 5, w / 2 + b - 2.5, w * 0.275, w / 2 + b, w * 0.275 - 2.5
|
|
|
+ sp.AppendLineSegment w / 2 + b, 0
|
|
|
+ sp.Closed = True
|
|
|
+ sr.Add ActiveLayer.CreateCurve(crv(3))
|
|
|
+
|
|
|
+ '// 移动到适合的地方
|
|
|
+ sr(1).Move 0, -w / 2: sr(1).Rotate 180
|
|
|
+ Set s = sr(1).Duplicate(0, 0): sr.Add s
|
|
|
+ s.Flip cdrFlipHorizontal: s.Move w + l, 0
|
|
|
+
|
|
|
+ sr(2).Rotate -90: sr(3).Rotate -90
|
|
|
+ sr(2).LeftX = 2 * w + l: sr(3).LeftX = w
|
|
|
+ sr(2).TopY = 0: sr(3).TopY = 0
|
|
|
+ Set DrawBottomWing = sr
|
|
|
+End Function
|
|
|
+
|
|
|
+
|
|
|
+Public Function Simple_box_four(Optional ByVal l As Double, Optional ByVal w As Double, Optional ByVal h As Double, Optional ByVal b As Double = 15)
|
|
|
+ Dim sr As New ShapeRange, wing As New ShapeRange
|
|
|
+ Dim sh As Shape
|
|
|
+ l1x = w: l2x = w + l: l3x = 2 * w + l: l4x = 2 * (w + l)
|
|
|
+
|
|
|
+
|
|
|
+ '// 绘制主体上下盖矩形
|
|
|
+ Set mainRect_aw = ActiveLayer.CreateRectangle(0, 0, w, h)
|
|
|
+ Set mainRect_al = ActiveLayer.CreateRectangle(0, 0, l, h)
|
|
|
+ mainRect_al.Move l1x, 0
|
|
|
+ Set mainRect_bw = ActiveLayer.CreateRectangle(0, 0, w, h)
|
|
|
+ mainRect_bw.Move l2x, 0
|
|
|
+ Set mainRect_bl = ActiveLayer.CreateRectangle(0, 0, l, h)
|
|
|
+ mainRect_bl.Move l3x, 0
|
|
|
+
|
|
|
+ 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
|
|
|
+ Set Bond = DrawBond(b, h, l4x, 0)
|
|
|
+
|
|
|
+ '// 绘制box 四个翅膀
|
|
|
+ Set sh = DrawWing(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).Rotate 180
|
|
|
+ wing(4).Flip cdrFlipVertical
|
|
|
+
|
|
|
+ '// 添加到物件组,设置轮廓色 C100
|
|
|
+ sr.Add mainRect_aw: sr.Add mainRect_al: sr.Add mainRect_bw: sr.Add mainRect_bl
|
|
|
+ sr.Add topRect: sr.Add bottomRect: sr.Add Bond
|
|
|
+ sr.Add top_RoundRect: sr.Add bottom_RoundRect
|
|
|
+ sr.AddRange wing: sh.Delete
|
|
|
+ sr.SetOutlineProperties Color:=CreateCMYKColor(100, 0, 0, 0)
|
|
|
+
|
|
|
+ sr.CreateSelection: sr.Group
|
|
|
+
|
|
|
+End Function
|
|
|
+
|
|
|
+Public Function input_box_lwh() As Variant
|
|
|
+ Dim str, arr, n
|
|
|
+ str = InputBox("请输入长x宽x高,使用空格 * x 间隔", "盒子长宽高", "100 x 100 x 100 mm") & " "
|
|
|
+ str = Newline_to_Space(str)
|
|
|
+
|
|
|
+ ' 替换 mm x * 换行 TAB 为空格
|
|
|
+ str = VBA.Replace(str, "mm", " ")
|
|
|
+ str = VBA.Replace(str, "x", " ")
|
|
|
+ str = VBA.Replace(str, "X", " ")
|
|
|
+ str = VBA.Replace(str, "*", " ")
|
|
|
+
|
|
|
+ '// 换行转空格 多个空格换成一个空格
|
|
|
+ str = API.Newline_to_Space(str)
|
|
|
+
|
|
|
+ arr = Split(str)
|
|
|
+ arr(0) = Val(arr(0))
|
|
|
+ arr(1) = Val(arr(1))
|
|
|
+ arr(2) = Val(arr(2))
|
|
|
+ arr(3) = Val(arr(3))
|
|
|
+ input_box_lwh = arr
|
|
|
+End Function
|
|
|
+
|
|
|
+Public Function Simple_box_three(Optional ByVal l As Double, Optional ByVal w As Double, Optional ByVal h As Double, Optional ByVal b As Double = 15)
|
|
|
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)
|
|
|
|
|
@@ -21,14 +187,14 @@ Public Function Simple_box_three()
|
|
|
bottom_RoundRect.Move l3x, -w - b
|
|
|
|
|
|
'// 绘制box 四个翅膀
|
|
|
- Set sh = DrawWing(ActiveLayer.CreateRectangle(0, 0, w, (w + b) / 2 - 2))
|
|
|
+ Set sh = DrawWing(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
|
|
|
+ wing(3).Rotate 180
|
|
|
+ wing(4).Flip cdrFlipVertical
|
|
|
|
|
|
'// 添加到物件组,设置轮廓色 C100
|
|
|
sr.Add mainRect: sr.Add topRect: sr.Add bottomRect
|
|
@@ -55,20 +221,19 @@ Private Function DrawLine(X1, Y1, X2, Y2) As Shape
|
|
|
End Function
|
|
|
|
|
|
|
|
|
-Private Function DrawWing(s As Shape) As Shape
|
|
|
+Private Function DrawWing(ByVal w As Double, ByVal h As Double) As Shape
|
|
|
Dim sp As SubPath, crv As Curve
|
|
|
- Dim x As Double, y As Double
|
|
|
- x = s.SizeWidth: y = s.SizeHeight
|
|
|
- s.Delete
|
|
|
+ Dim x As Double, Y As Double
|
|
|
+ x = w: Y = h
|
|
|
|
|
|
'// 绘制 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 6, Y - 2.5
|
|
|
+ sp.AppendCurveSegment2 8.5, Y, 6.2, Y - 1.25, 7, Y
|
|
|
+ sp.AppendLineSegment x - 2, Y
|
|
|
sp.AppendLineSegment x - 2, 3
|
|
|
sp.AppendLineSegment x, 0
|
|
|
|
|
@@ -76,6 +241,24 @@ Private Function DrawWing(s As Shape) As Shape
|
|
|
Set DrawWing = ActiveLayer.CreateCurve(crv)
|
|
|
End Function
|
|
|
|
|
|
+Private Function DrawBond(ByVal w As Double, ByVal h As Double, ByVal move_x As Double, ByVal move_y As Double) As Shape
|
|
|
+ Dim sp As SubPath, crv As Curve
|
|
|
+ Dim x As Double, Y As Double
|
|
|
+ x = w: Y = h
|
|
|
+
|
|
|
+ '// 绘制 Box 粘合边 Bond
|
|
|
+ Set crv = Application.CreateCurve(ActiveDocument)
|
|
|
+ Set sp = crv.CreateSubPath(0, 0)
|
|
|
+ sp.AppendLineSegment 0, Y
|
|
|
+ sp.AppendLineSegment x, Y - 5
|
|
|
+ sp.AppendLineSegment x, 5
|
|
|
+
|
|
|
+ sp.Closed = True
|
|
|
+ Set DrawBond = ActiveLayer.CreateCurve(crv)
|
|
|
+ DrawBond.Move move_x, move_y
|
|
|
+End Function
|
|
|
+
|
|
|
+
|
|
|
Public Function Simple_box_one()
|
|
|
ActiveDocument.Unit = cdrMillimeter
|
|
|
l = 100: w = 50: h = 70: b = 15
|