AutoCAD VBA创建椭圆和样条曲线

AutoCAD VBA创建椭圆和样条曲线，代码如下。

Public Function AddEllipse(ByVal ptCen As Variant, ByVal ptmajAxis As Variant, ByVal radRatio As Double) As AcadEllipse
Set AddEllipse = ThisDrawing.ModelSpace.AddEllipse(ptCen, ptmajAxis, radRatio)
End Function
Public Function AddEllipseRec(ByVal pt1 As Variant, ByVal pt2 As Variant, ByVal angle As Double) As AcadEllipse
Dim majAxisLen, minAxisLen As Double
Dim ptCen As Variant
Dim radRatio As Double
Dim ptmajAxis(0 To 2) As Double
Dim objEllipse As AcadEllipse
majAxisLen = Abs(pt1(0) - pt2(0))
minAxisLen = Abs(pt1(1) - pt2(1))
radRatio = minAxisLen / majAxisLen
If radRatio < 1 Then
ptmajAxis(0) = majAxisLen / 2: ptmajAxis(1) = 0: ptmajAxis(2) = 0
ElseIf radRatio > 1 Then
ptmajAxis(0) = 0: ptmajAxis(1) = minAxisLen / 2: ptmajAxis(2) = 0
Else
MsgBox "参数错误，无法创建椭圆！"
Exit Function
End If
ptCen = GetMidPt(pt1, pt2)
Set objEllipse = AddEllipse(ptCen, ptmajAxis, radRatio)
objEllipse.Rotate ptCen, angle
objEllipse.Update
Set AddEllipseRec = objEllipse
End Function
Public Function GetMidPt(pt1 As Variant, pt2 As Variant) As Variant
Dim ptMid(0 To 2) As Double
ptMid(0) = (pt1(0) + pt2(0)) / 2
ptMid(1) = (pt1(1) + pt2(1)) / 2
ptMid(0) = 0
GetMidPt = ptMid
End Function
Public Function AddSpline(ByRef ptArr() As Double, ByVal vecSt As Variant, ByVal vecEn As Variant) As AcadSpline
If (UBound(ptArr) + 1) Mod 3 <> 0 Then
MsgBox "数组参数无法创建样条曲线！"
Exit Function
End If
Set AddSpline = ThisDrawing.ModelSpace.AddSpline(ptArr, vecSt, vecEn)
End Function

Sub TestElandSp()
Dim ptCen(0 To 2) As Double
Dim ptmajAxis(0 To 2) As Double
Dim radRatio As Double
ptCen(0) = 150: ptCen(1) = 150: ptCen(2) = 0
ptmajAxis(0) = 30: ptmajAxis(1) = 0: ptmajAxis(2) = 0
radRatio = 0.3
AddEllipse ptCen, ptmajAxis, radRatio
ptCen(0) = 50: ptCen(1) = 50: ptCen(2) = 0
ptmajAxis(0) = 100: ptmajAxis(1) = 120: ptmajAxis(2) = 0
AddEllipseRec ptCen, ptmajAxis, 0
Dim vec1(2) As Double
Dim vec2(2) As Double
Dim ptArr(14) As Double
vec1(0) = -1: vec1(1) = -1: vec1(2) = 0
vec2(0) = 1: vec1(1) = -1: vec2(2) = 0
ptArr(0) = 0: ptArr(1) = 50: ptArr(2) = 0: ptArr(3) = 20: ptArr(4) = 90: ptArr(5) = 0
ptArr(6) = 40: ptArr(7) = 50: ptArr(8) = 0: ptArr(9) = 60: ptArr(10) = 90: ptArr(11) = 0
ptArr(12) = 80: ptArr(13) = 50: ptArr(14) = 0
AddSpline ptArr, vec1, vec2
ZoomAll
End Sub

代码完。

基本建模失败。