Center Point of Rectangle

Is there a way to get the midpoint, or center, of a rectangle??

I've got some code that will draw a rectangle based on 2 points. I would then like to add some text in the middle of the rectangle.
How can I go about getting the midpoint??
I'm not even sure I'm going about it the right way, but here's what I've got so far....


--------------------------------------------------------------------------------

Public Sub Test()
Rectangle ThisDrawing.Utility.GetPoint(, "Point 1"), ThisDrawing.Utility.GetPoint(, "Point 1")
' Now add text at the midpoint of the rectangle...
End Sub

' From Frank Oquendo
Public Function Rectangle(Point1, Point2) As AcadLWPolyline
Dim vertices(0 To 7) As Double, pl As AcadLWPolyline

vertices(0) = CDbl(Point1(0)): vertices(1) = CDbl(Point1(1))
vertices(2) = CDbl(Point2(0)): vertices(3) = CDbl(Point1(1))
vertices(4) = CDbl(Point2(0)): vertices(5) = CDbl(Point2(1))
vertices(6) = CDbl(Point1(0)): vertices(7) = CDbl(Point2(1))

Set pl = ThisDrawing.ModelSpace.AddLightWeightPolyline(vertices)
pl.Closed = True
Set Rectangle = pl
End Function

--------------------------------------------------------------------------------

Matt W

There are 3 kinds of people:
Those who can count, and those who can't.

 

I think you can do this buy adding the x an y values and dividing by 2.

mid(0) = (Point1(0) + Point2(0)) / 2
mid(1) = (Point1(1) + Point2(1)) / 2

 

Matt,
I couldn't help running with this one...
The text height is arbitrarily set to 1/2 of the rectangle height.
Watch out for word-wrap.
James

Public Sub Test()
Dim pnt1 As Variant, pnt2 As Variant
Dim ctr(0 To 2) As Double, ht As Double
Dim newText As AcadText
If getPoints(pnt1, pnt2) = 0 Then 'no CANCEL
Rectangle pnt1, pnt2
' Now add text at the midpoint of the rectangle...
ctr(0) = (pnt1(0) + pnt2(0)) / 2
ctr(1) = (pnt1(1) + pnt2(1)) / 2
ctr(2) = (pnt1(2) + pnt2(2)) / 2
ht = Abs(pnt1(1) - pnt2(1)) / 2
Set newText = ThisDrawing.ModelSpace.AddText("text", ctr, ht)
newText.Alignment = acAlignmentMiddle
newText.TextAlignmentPoint = ctr
'newText.Update
End If
End Sub

' From Frank Oquendo
Public Function Rectangle(Point1, Point2) As AcadLWPolyline
Dim vertices(0 To 7) As Double, pl As AcadLWPolyline

vertices(0) = CDbl(Point1(0)): vertices(1) = CDbl(Point1(1))
vertices(2) = CDbl(Point2(0)): vertices(3) = CDbl(Point1(1))
vertices(4) = CDbl(Point2(0)): vertices(5) = CDbl(Point2(1))
vertices(6) = CDbl(Point1(0)): vertices(7) = CDbl(Point2(1))

Set pl = ThisDrawing.ModelSpace.AddLightWeightPolyline(vertices)
pl.Closed = True
Set Rectangle = pl
End Function

Function getPoints(pt1 As Variant, pt2 As Variant) As Integer
' This sub returns two points, or an error flag if cancelled

On Error Resume Next
pt1 = ThisDrawing.Utility.GetPoint(, "Specify first corner:")
If Err Then
getPoints = -1
Exit Function
End If
pt2 = ThisDrawing.Utility.GetCorner(pt1, "Specify opposite corner:")
If Err Then
getPoints = -1
Exit Function
End If
On Error GoTo 0

End Function 'getPoints

 

Some time ago I wrote myself a function that emulates the Centroid property for entities that don't have one. It does this by creating a region based on the entity and then getting the centroid of that.

Private Function EntityCentroid(Entity As AcadEntity) As Double()
Dim EntityArray(0) As AcadEntity, RegionList As Variant

Set EntityArray(0) = Entity
RegionList = ThisDrawing.ModelSpace.AddRegion(EntityArray)
EntityCentroid = RegionList(0).Centroid
RegionList(0).Delete
End Function

Regards

Wayne Ivory
IT Analyst Programmer
Wespine Industries Pty Ltd