[VBA 基本訓練] 畫矩形(rectangle), 中間自動加一條中線.

Public Const pi = 3.141592 / 180

Option Explicit

Public Sub rect_line()

ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr

On Error Resume Next

Dim tm As AcadModelSpace
Dim tu As AcadUtility
Dim insert_p As Variant
Dim p2 As Variant
Dim first_angle As Double
Dim second_angle As Double
Dim p3 As Variant
Dim p4 As Variant
Dim rect_heigth As Double
Dim rect_width As Double
Dim cir As AcadCircle
Dim line_obj As AcadLine
Dim insert_str As String
Dim p2_str As String

Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility

' input 2 corners of rectangle
insert_p = tu.GetPoint(, "first corner !!....... ")

If Err Then Exit Sub

p2 = tu.GetCorner(insert_p, "second corner !!.....")

If Err Then Exit Sub

' get the height and width of rectangle
rect_heigth = Abs(p2(1) - insert_p(1)): rect_width = Abs(p2(0) - insert_p(0))

' turn coordinate number to string for sendcommand to draw rectangle
insert_str = Trim(Str(insert_p(0))) & "," & Trim(Str(insert_p(1)))
p2_str = Trim(Str(p2(0))) & "," & Trim(Str(p2(1)))

ThisDrawing.SendCommand "rectangle" & vbCr & insert_str & vbCr & p2_str & vbCr

' judge second corner on which corner, right-up, right-down, left-up, left-down
If p2(0) > insert_p(0) And p2(1) > insert_p(1) Then first_angle = 90 * pi: second_angle = 0
If p2(0) < insert_p(0) And p2(1) > insert_p(1) Then first_angle = 90 * pi: second_angle = 180 * pi
If p2(0) < insert_p(0) And p2(1) < insert_p(1) Then first_angle = 270 * pi: second_angle = 180 * pi
If p2(0) > insert_p(0) And p2(1) < insert_p(1) Then first_angle = 270 * pi: second_angle = 0

' get line startpoint and endpoint
p3 = tu.PolarPoint(insert_p, first_angle, rect_heigth / 2)
p4 = tu.PolarPoint(p3, second_angle, rect_width)

Set line_obj = tm.AddLine(p3, p4): line_obj.Update

ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr

End Sub

超棒的VBA範例程式。

感謝大大無私地分享......感恩