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

代碼完。

基本建模失敗。