[求助]：求用VBA画正方形的程序

guohq

谁告诉我用VBA画正方形的程序？？？
谢谢

ahua

下面是一个画矩形的程序，改改就可以画正方形
Sub DrawBox()
Dim objUtil As AcadUtility
Dim varPnt1 As Variant
Dim varPntLP As Variant
Dim dblPoints() As Double
Dim blnContinue As Boolean
Dim intcnt As Integer
Dim intPoints As Integer
Dim objPLine As AcadLWPolyline
Dim objNewPLine As AcadLWPolyline
On Error GoTo Err_Control

Set objUtil = ThisDrawing.Utility

varPnt1 = objUtil.GetPoint(, "Select First Point")

For intcnt = 0 To 1
ReDim Preserve dblPoints(intcnt)
    dblPoints(intcnt) = varPnt1(intcnt)
Next intcnt

intPoints = 2

varPntLP = varPnt1

Do Until blnContinue = True
    varPntLP = objUtil.GetPoint(varPntLP, "Select Next Point or <Enter> to Finish:")
    For intcnt = 0 To 1
    ReDim Preserve dblPoints(intPoints)
         dblPoints(intPoints) = varPntLP(intcnt)
         intPoints = intPoints + 1
    Next intcnt
Loop

Add_PLine:
Set objPLine = ThisDrawing.ModelSpace.AddLightWeightPolyline(dblPoints)
Set objNewPLine = objPLine.Offset(0.5)

Exit_Here:
Exit Sub

Err_Control:
Select Case Err.Number
Case -2145320928
    Err.Clear
    GoTo Add_PLine
Case Else
    MsgBox Err.Number & vbCr & Err.Description
End Select

End Sub

guohq

能不能帮我改成正方形的？  谢谢！！我要考试！！