Public Sub creatcircle() Dim centerpoint(0 To 2) As Double setpoint3d centpoint, 0, 0, 0 Dim mspace As New clsModelSpace mspace.AddCircle centerpoint, 50 Dim startpoint(0 To 2) As Double, endpoint(0 To 2) As Double setpoint3d startpoint, 50, 0, 0 setpoint3d endpoint, 150, 0, 0 mspace.AddCircleBy2Point startpoint, endpoint End Sub Public Function setpoint3d(ByVal point As Variant, ByVal x As Double, ByVal y As Double, ByVal z As Double) Debug.Assert (VarType(point) = vbArray + vbDouble)----------------------------错误地方!!!!!!!!!!!!!! Debug.Assert (LBound(point) = 0 And UBound(point) = 2) point(0) = x point(1) = y point(2) = z End Function Public Function GetDistanceBetween2Point(ByVal startpoint As Variant, ByVal endpoint As Variant) As Double Dim a As Double, b As Double, c As Double x = startpoint(0) - endpoint(0) y = startpoint(1) - endpoint(1) z = startpoint(2) - endpoint(2) GetDistanceBetween2Point = Sqr(x ^ 2 + y ^ 2 + z ^ 2) End Function Public Function GetMiddlePointBetween2Point(ByVal startpoint As Variant, ByVal endpoint As Variant) As Double Dim midpoint(0 To 2) As Double midpoint(0) = (startpoint(0) - endpoint(0)) / 2 midpoint(1) = (startpoint(1) - endpoint(1)) / 2 midpoint(2) = (startpoint(2) - endpoint(2)) / 2 GetMiddlePointBetween2Point = midpoint End Function Public Function AddCircle(ByVal centerpoint As Variant, ByVal radius As Double) As AcadCircle Debug.Assert (radius > 0.0000001) Debug.Assert (VarType(centerpoint) = vbArray + vbDouble) Set AddCircle = ThisDrawing.ModelSpace.AddCircle(centerpoint, radius) End Function Public Function AddCircleBy2Point(ByVal startpoint As Variant, ByVal endpoint As Variant) As AcadCircle Debug.Assert (VarType(startpoint) = vbArray + vbDouble) Debug.Assert (VarType(endpoint) = vbArray + vbDouble) '计算圆心和半径 Dim centerpoint As Variant, radius As Double centerpoint = math.GetMiddlePointBetween2Point(startpoint, endpoint) radius = math.GetDistanceBetween2Point(startpoint, endpoint) / 2 Set AddCircleBy2Point = AddCircle(centerpoint, radius) End Function
|