Donor list MakeSizePlus ArrangeForm

README.md

@@ -12,6 +12,12 @@
 # [CorelDRAW VBA](https://262235.xyz/index.php/tag/vba/)
 ![](https://262235.xyz/usr/uploads/2022/03/525753621.webp)
 
+
+## [【CorelDRAW免费开源插件-蘭雅CorelVBA安装简易教程】](https://www.bilibili.com/video/BV1Nc411J7Mq)
+
+### https://www.bilibili.com/video/BV1Nc411J7Mq
+
+
 ## [蘭雅CorelVBA 2023.1.1版 免费开源开放下载](https://262235.xyz/262235_GMS_0101.7z)
 ### https://262235.xyz/262235_GMS_0101.7z
 

UI/ArrangeForm.bas

@@ -1,6 +1,6 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ArrangeForm 
-   Caption         =   "蘭雅sRGB 手动拼版"
+   Caption         =   "蘭雅sRGB 自动拼版 │ 嘉盟赞助"
    ClientHeight    =   2475
    ClientLeft      =   45
    ClientTop       =   330
@@ -16,6 +16,49 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
+'// 用户窗口初始化
+Private Sub UserForm_Initialize()
+  ActiveDocument.Unit = cdrMillimeter
+  Dim sr As ShapeRange
+  Dim ls, hs, lj, hj, pw, ph As Double
+  
+  pw = ActiveDocument.Pages.First.SizeWidth
+  ph = ActiveDocument.Pages.First.SizeHeight
+  TextBox1.text = 2
+  TextBox2.text = 5
+  TextBox3.text = 0
+  TextBox4.text = 0
+  
+  Set sr = ActiveSelectionRange
+  If sr.Count > 0 Then
+    ls = Int(sr.SizeWidth + 0.5)
+    hs = Int(sr.SizeHeight + 0.5)
+    Label_Size.Caption = "尺寸: " & ls & "×" & hs & "mm"
+    
+    lj = Int(pw / ls)
+    hj = Int(ph / hs)
+    
+    Dim jh, jl, t As Double
+    jl = Int(pw / hs)
+    jh = Int(ph / ls)
+    
+'//  Debug.Print lj, hj, jl, jh
+    If jh * jl > hj * lj Then
+      lj = jl
+      hj = jh
+      If lj * ls > pw Or hj * hs > ph Then
+        t = lj
+        lj = hj
+        hj = t
+      End If
+    End If
+    
+    
+    TextBox1.text = lj
+    TextBox2.text = hj
+  End If
+End Sub
+
 Private Sub CommandButton1_Click()
   On Error GoTo ErrorHandler
   API.BeginOpt
@@ -52,18 +95,18 @@ Private Function arrange_Clone(matrix As Variant, sr As ShapeRange)
   ls = matrix(0): hs = matrix(1)
   lj = matrix(2): hj = matrix(3)
   x = sr.SizeWidth: Y = sr.SizeHeight
-  Set s1 = sr.Clone
+  Set s1 = sr '// Set s1 = sr.Clone
   '// StepAndRepeat 方法在范围内创建多个形状副本
   Set dup1 = s1.StepAndRepeat(ls - 1, x + lj, 0#)
   Set dup2 = ActiveDocument.CreateShapeRangeFromArray(dup1, s1).StepAndRepeat(hs - 1, 0#, -(Y + hj))
-  s1.Delete
+  '// s1.Delete
 End Function
 
 Private Function arrange_Clone_one(matrix As Variant, sr As ShapeRange)
   ls = matrix(0): hs = matrix(1)
   lj = matrix(2): hj = matrix(3)
   x = sr.SizeWidth: Y = sr.SizeHeight
-  Set s1 = sr.Clone
+  Set s1 = sr '// Set s1 = sr.Clone
   '// StepAndRepeat 方法在范围内创建多个形状副本
   If ls > 1 Then
     Set dup1 = s1.StepAndRepeat(ls - 1, x + lj, 0#)
@@ -73,6 +116,6 @@ Private Function arrange_Clone_one(matrix As Variant, sr As ShapeRange)
   If hs > 1 Then
     Set dup2 = ActiveDocument.CreateShapeRangeFromArray(dup1, s1).StepAndRepeat(hs - 1, 0#, -(Y + hj))
   End If
-  s1.Delete
+  '// s1.Delete
 End Function
 

UI/MakeSizePlus.bas

@@ -1,7 +1,7 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} MakeSizePlus 
    Caption         =   "Batch Dimension Nodes"
-   ClientHeight    =   1470
+   ClientHeight    =   1680
    ClientLeft      =   45
    ClientTop       =   330
    ClientWidth     =   3900
@@ -13,6 +13,7 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
+
 '// This is free and unencumbered software released into the public domain.
 '// For more information, please refer to  https://github.com/hongwenjun
 
@@ -65,13 +66,13 @@ Private Function MiniForm()
     .width = 98
     
     .MarkLines_Makesize.Visible = True
-    .btn_makesizes.Visible = True
+    .btn_Makesizes.Visible = True
     .Manual_Makesize.Visible = True
     .chkOpposite.Visible = True
     .X_EXIT.Visible = True
     
     .MarkLines_Makesize.Left = 1
-    .btn_makesizes.Left = 26
+    .btn_Makesizes.Left = 26
     .Manual_Makesize.Left = 50
     .chkOpposite.Left = 75: .chkOpposite.Top = 14
     .X_EXIT.Left = 85: .X_EXIT.Top = 0
@@ -585,6 +586,59 @@ Private Sub Makesize_Down_MouseUp(ByVal Button As Integer, ByVal Shift As Intege
   End If
 End Sub
 
+Private Sub MakeRuler_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+  If Button = 2 Then
+    CutLines.Dimension_MarkLines cdrAlignLeft, False
+    Add_Ruler_Text_Y True
+  Else
+    '// 建立标尺线
+    CutLines.Dimension_MarkLines cdrAlignTop, False
+    '// 标尺线转换成距离数字
+    Add_Ruler_Text True
+  End If
+End Sub
+
+  '// 标尺线转换成距离数字
+Private Function Add_Ruler_Text(rm_lines As Boolean)
+  API.BeginOpt
+  Dim s As Shape, t As Shape, sr As ShapeRange
+  Dim text As String
+  Set sr = ActiveSelectionRange
+  sr.Sort "@shape1.left < @shape2.left"
+  For Each s In sr
+    x = s.CenterX: Y = s.CenterY
+    text = str(Int(x - sr.FirstShape.CenterX + 0.5))
+    Set t = ActiveLayer.CreateArtisticText(x, Y, text)
+    t.CenterX = x: t.CenterY = Y
+  Next
+  
+  If rm_lines Then sr.Delete
+  
+  API.EndOpt
+End Function
+
+  '// 标尺线转换成距离数字
+Private Function Add_Ruler_Text_Y(rm_lines As Boolean)
+  API.BeginOpt
+  Dim s As Shape, t As Shape, sr As ShapeRange
+  Dim text As String
+  Set sr = ActiveSelectionRange
+  sr.Sort "@shape1.top < @shape2.top"
+  For Each s In sr
+    x = s.CenterX: Y = s.CenterY
+    text = str(Int(Y - sr.FirstShape.CenterY + 0.5))
+    Set t = ActiveLayer.CreateArtisticText(x, Y, text)
+    t.CenterX = x: t.CenterY = Y
+  Next
+  
+  If rm_lines Then sr.Delete
+  
+  API.EndOpt
+End Function
+
+
 Private Sub X_EXIT_Click()
   Unload Me    '// EXIT
 End Sub
+
+

donate.md

@@ -14,7 +14,7 @@
 
 | 微信支付 | 支付宝 |
 | ------- | ------- |
-| ![](https://262235.xyz/donate/WXPay.png) | ![](https://262235.xyz/donate/AliPay.jpg) |
+| ![](https://lyvba.com/donate/WXPay.png) | ![](https://lyvba.com/donate/AliPay.jpg) |
 
 ### 捐赠者:
 ```
@@ -52,6 +52,7 @@ Thanh Van
 晋畅迷你字
 cdr_插件 鼠标哥
 w啊啊
+上善若水
 ```