通过对角两点绘制矩形的函数 Function AddRectangle(varPnt1 As Variant, varPnt2 As Variant) As AcadLWPolyline On Error GoTo Err_Control Dim objSpace As AcadBlock If ThisDrawing.ActiveSpace = acModelSpace Then Set objSpace = ThisDrawing.ModelSpace Else Set objSpace = ThisDrawing.PaperSpace End If Dim plineObj As AcadLWPolyline Dim points(0 To 7) As Double points(0) = varPnt1(0): points(1) = varPnt1(1) points(2) = varPnt1(0): points(3) = varPnt2(1) points(4) = varPnt2(0): points(5) = varPnt2(1) points(6) = varPnt2(0): points(7) = varPnt1(1) Set plineObj = objSpace.AddLightWeightPolyline(points) plineObj.Closed = True Set AddRectangle = plineObj Exit_Here: Exit Function Err_Control: Resume Exit_Here End Function Sub addrec() Dim pnt1 As Variant Dim pnt2 As Variant pnt1 = ThisDrawing.Utility.GetPoint(, "请输入角点:") pnt2 = ThisDrawing.Utility.GetCorner(pnt1, "请输入另一角点:") AddRectangle pnt1, pnt2 End Sub |