LinesForm.frm 5.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193
  1. VERSION 5.00
  2. Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} LinesForm
  3. Caption = "LinesForm"
  4. ClientHeight = 2430
  5. ClientLeft = 45
  6. ClientTop = 390
  7. ClientWidth = 4680
  8. OleObjectBlob = "LinesForm.frx":0000
  9. StartUpPosition = 1 'CenterOwner
  10. End
  11. Attribute VB_Name = "LinesForm"
  12. Attribute VB_GlobalNameSpace = False
  13. Attribute VB_Creatable = False
  14. Attribute VB_PredeclaredId = True
  15. Attribute VB_Exposed = False
  16. '// This is free and unencumbered software released into the public domain.
  17. '// For more information, please refer to https://github.com/hongwenjun
  18. '// 插件名称 VBA_UserForm
  19. Private Const TOOLNAME As String = "LYVBA"
  20. Private Const SECTION As String = "LinesForm"
  21. '// 用户窗口初始化
  22. Private Sub UserForm_Initialize()
  23. With Me
  24. .StartUpPosition = 0
  25. .Left = Val(GetSetting(TOOLNAME, SECTION, "form_left", 900))
  26. .Top = Val(GetSetting(TOOLNAME, SECTION, "form_top", 200))
  27. End With
  28. End Sub
  29. '// 关闭窗口时保存窗口位置
  30. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  31. saveFormPos True
  32. End Sub
  33. '// 保存窗口位置和加载窗口位置
  34. Sub saveFormPos(bDoSave As Boolean)
  35. If bDoSave Then 'save position
  36. SaveSetting TOOLNAME, SECTION, "form_left", Me.Left
  37. SaveSetting TOOLNAME, SECTION, "form_top", Me.Top
  38. End If
  39. End Sub
  40. Private Sub MyPen_Click()
  41. On Error GoTo ErrorHandler
  42. API.BeginOpt
  43. lines.Nodes_DrawLines
  44. ErrorHandler:
  45. API.EndOpt
  46. End Sub
  47. '// 左键右键Ctrl三键控制
  48. Private Sub PenDrawLines_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  49. On Error GoTo ErrorHandler
  50. API.BeginOpt
  51. If Button = 2 Then
  52. lines.Draw_Multiple_Lines cdrAlignVCenter
  53. ElseIf Shift = fmCtrlMask Then
  54. lines.Draw_Multiple_Lines cdrAlignHCenter
  55. Else
  56. lines.Draw_Multiple_Lines 0
  57. End If
  58. ErrorHandler:
  59. API.EndOpt
  60. End Sub
  61. '''//// 傻瓜火车排列 ////'''
  62. Private Sub TOP_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  63. If Button = 2 Then
  64. Tools.Simple_Train_Arrangement 3#
  65. ElseIf Shift = fmCtrlMask Then
  66. Tools.Simple_Train_Arrangement 0#
  67. Else
  68. Tools.Simple_Train_Arrangement Set_Space_Width
  69. End If
  70. End Sub
  71. '''//// 傻瓜阶梯排列 ////'''
  72. Private Sub LEFT_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  73. If Button = 2 Then
  74. Tools.Simple_Ladder_Arrangement 3#
  75. ElseIf Shift = fmCtrlMask Then
  76. Tools.Simple_Ladder_Arrangement 0#
  77. Else
  78. Tools.Simple_Ladder_Arrangement Set_Space_Width
  79. End If
  80. End Sub
  81. Private Sub MakeBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  82. On Error GoTo ErrorHandler
  83. API.BeginOpt
  84. Dim size As Variant
  85. size = input_box_lwh
  86. l = size(0): w = size(1): h = size(2): b = size(3)
  87. If b = 0 Then b = 15
  88. If Button = 2 Then
  89. box.Simple_box_five l, w, h, b
  90. ElseIf Shift = fmCtrlMask Then
  91. box.Simple_box_four l, w, h, b
  92. Else
  93. box.Simple_box_three l, w, h, b
  94. End If
  95. ErrorHandler:
  96. API.EndOpt
  97. End Sub
  98. Private Sub Cmd_3D_Click()
  99. box.Simple_3Deffect
  100. End Sub
  101. '// 角度和旋转工具, 左键左转,右键右转
  102. Private Sub Rotate_Shapes_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  103. If Button = 2 Then '// 右键的代码
  104. Shapes_Rotate -90
  105. ElseIf Shift = fmCtrlMask Then '// 左键的代码
  106. Shapes_Rotate 90
  107. Else '// CTRL的代码
  108. Shapes_Rotate -45
  109. End If
  110. End Sub
  111. '// 移动和再制,我们来制作三键控制,左键只移动,右键是反方向,按CTRL 是复制的
  112. Private Sub Move_Left_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  113. If Button = 2 Then '// 右键的代码
  114. move_shapes 100, 0
  115. ElseIf Shift = fmCtrlMask Then '// 左键的代码
  116. move_shapes -100, 0
  117. Else '// CTRL的代码
  118. Duplicate_shapes -100, 0
  119. End If
  120. End Sub
  121. Private Sub Move_Up_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  122. If Button = 2 Then '// 右键的代码
  123. move_shapes 0, -100
  124. ElseIf Shift = fmCtrlMask Then '// 左键的代码
  125. move_shapes 0, 100
  126. Else '// CTRL的代码
  127. Duplicate_shapes 0, 100
  128. End If
  129. End Sub
  130. '// 测量标尺和水平尺
  131. Private Sub Ruler_Measuring_BT_Click()
  132. '// 角度转平
  133. Angle_to_Horizon
  134. End Sub
  135. '// 选择的物件平均距离
  136. Private Sub Average_Distance_BT_Click()
  137. Average_Distance
  138. End Sub
  139. Private Sub chkAutoDistribute_Click()
  140. AutoDistribute_Key = chkAutoDistribute.Value
  141. End Sub
  142. '// 镜像工具
  143. Private Sub MirrorLine_Click()
  144. Mirror_ByGuide
  145. End Sub
  146. '// 平行线工具 CTRL 键设置距离
  147. Private Sub ParallelLines_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  148. Dim sp As Double
  149. text = GlobalUserData("SpaceWidth", 1)
  150. sp = Val(text)
  151. If Button = 2 Then '// 右键的代码
  152. Create_Parallel_Lines -sp
  153. ElseIf Shift = fmCtrlMask Then '// 左键的代码
  154. Create_Parallel_Lines sp
  155. Else '// CTRL的代码
  156. Create_Parallel_Lines Set_Space_Width
  157. End If
  158. End Sub
  159. '// 标记镜像参考线
  160. Private Sub Set_Guide_Click()
  161. Set_Guides_Name
  162. End Sub