Another rectangle question...

How can a rectangle be created (if the length is 4 and the height is 2) by selecting just one point??
I want to be able to create a rectangle that is 4 x 2 simply by picking what would be the center of the rectangle.

Thanks in advance!

 

Here you go....


Public Sub Test()
Const rectWidth = 4
Const rectHeight = 2

Dim pnt1(0 To 2) As Double, pnt2(0 To 2) As Double
Dim ctr As Variant, ht As Double
Dim newText As AcadText
Dim boolAnother As Boolean

boolAnother = True
Do While boolAnother = True
If getPoint(ctr) = 0 Then 'no CANCEL

pnt1(0) = ctr(0) - rectWidth / 2
pnt1(1) = ctr(1) - rectHeight / 2
pnt1(2) = ctr(2)
pnt2(0) = pnt1(0) + rectWidth
pnt2(1) = pnt1(1) + rectHeight
pnt2(2) = ctr(2)

Rectangle pnt1, pnt2

' Now add text at the midpoint of the rectangle...
ht = rectHeight / 2

Set newText = ThisDrawing.ModelSpace.AddText("text", ctr, ht)
newText.Alignment = acAlignmentMiddle
newText.TextAlignmentPoint = ctr
Else
boolAnother = False
End If
Loop
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 getPoint(pt1 As Variant) As Integer
' This sub returns a point, or an error flag if cancelled

On Error Resume Next
pt1 = ThisDrawing.Utility.getPoint(, "Specify center point:")
If Err Then
getPoint = -1
Exit Function
End If
On Error GoTo 0

End Function 'getPoint




How can a rectangle be created (if the length is 4 and the height is 2) by
selecting just one point??
I want to be able to create a rectangle that is 4 x 2 simply by picking what
would be the center of the rectangle.

Thanks in advance!

 

Ahhh.... You took it one more step and added the text. That was going to be
my next move.

Thanks for all your help.