AutoCAD二次开发教程（2）-通过VB6绘制曲线

环境与引用步骤同：AutoCAD二次开发教程（1）-通过VB6绘制直线

1：绘制整圆

绘制代码如下：

On Error Resume Next
' 连接至 AutoCAD 应用程序
Dim acadApp As AcadApplication
Dim docObj As AcadDocument
Set acadApp = GetObject(, "AutoCAD.Application.17.1")
Set docObj = acadApp.Application.Documents.Add
If Err Then
    Err.Clear
    Set acadApp = CreateObject("AutoCAD.Application.17.1")
    Set docObj = acadApp.Application.Documents.Add
    If Err Then
        MsgBox ("无法运行AutoCAD2008，请检查是否安装了AutoCAD2008")
        Exit Sub
    End If
End If

' 连接至 AutoCAD 图形
Dim acadDoc As AcadDocument
Set acadDoc = acadApp.ActiveDocument
acadApp.Visible = True

' 绘制圆
   
Dim circleObj As AcadCircle
Dim centerPoint(0 To 2) As Double
Dim radius As Double

' 定义圆心与半径
centerPoint(0) = 0
centerPoint(1) = 0
centerPoint(2) = 0
radius = 100

' 绘制圆
Set circleObj = acadDoc.ModelSpace.AddCircle(centerPoint, radius)

ZoomAll

绘制一个圆形在(0,0,0)，半径为100的圆，图形如下：

2：绘制圆弧

要绘制圆弧的话除了要定义圆心与半径，还需要定义起点角度与终止角度，代码如下：

On Error Resume Next
' 连接至 AutoCAD 应用程序
Dim acadApp As AcadApplication
Dim docObj As AcadDocument
Set acadApp = GetObject(, "AutoCAD.Application.17.1")
Set docObj = acadApp.Application.Documents.Add
If Err Then
    Err.Clear
    Set acadApp = CreateObject("AutoCAD.Application.17.1")
    Set docObj = acadApp.Application.Documents.Add
    If Err Then
        MsgBox ("无法运行AutoCAD2008，请检查是否安装了AutoCAD2008")
        Exit Sub
    End If
End If

' 连接至 AutoCAD 图形
Dim acadDoc As AcadDocument
Set acadDoc = acadApp.ActiveDocument
acadApp.Visible = True

' 绘制圆弧
   
Dim ArcObj As AcadArc
Dim centerPoint(0 To 2) As Double
Dim radius As Double
Dim StartAngle As Double
Dim EndAngle As Double

' 定义圆心、半径与起始角度
centerPoint(0) = 100
centerPoint(1) = 100
centerPoint(2) = 0
radius = 100
StartAngle = -90 * (3.14159 / 180)
EndAngle = 90 * (3.14159 / 180)

' 绘制圆弧
Set ArcObj = acadDoc.ModelSpace.AddArc(centerPoint, radius, StartAngle, EndAngle)
ZoomAll

绘制的图形如下：

3：绘制椭圆

代码如下：

On Error Resume Next
' 连接至 AutoCAD 应用程序
Dim acadApp As AcadApplication
Dim docObj As AcadDocument
Set acadApp = GetObject(, "AutoCAD.Application.17.1")
Set docObj = acadApp.Application.Documents.Add
If Err Then
    Err.Clear
    Set acadApp = CreateObject("AutoCAD.Application.17.1")
    Set docObj = acadApp.Application.Documents.Add
    If Err Then
        MsgBox ("无法运行AutoCAD2008，请检查是否安装了AutoCAD2008")
        Exit Sub
    End If
End If

' 连接至 AutoCAD 图形
Dim acadDoc As AcadDocument
Set acadDoc = acadApp.ActiveDocument
acadApp.Visible = True

 ' 绘制椭圆

Dim ellObj As AcadEllipse
Dim majAxis(0 To 2) As Double
Dim center(0 To 2) As Double
Dim radRatio As Double

' 创建椭圆
center(0) = 0
center(1) = 0
center(2) = 0
majAxis(0) = 10
majAxis(1) = 0
majAxis(2) = 0
radRatio = 0.5
Set ellObj = acadDoc.ModelSpace.AddEllipse(center, majAxis, radRatio)

ZoomExtents

绘制一个中心点center(0,0,0)，长半轴majAxis(0)为10（相对于中心的增量），长短轴比值radRatio为0.5的椭圆。效果如下：

4：绘制椭圆弧

代码如下：

On Error Resume Next
' 连接至 AutoCAD 应用程序
Dim acadApp As AcadApplication
Dim docObj As AcadDocument
Set acadApp = GetObject(, "AutoCAD.Application.17.1")
Set docObj = acadApp.Application.Documents.Add
If Err Then
    Err.Clear
    Set acadApp = CreateObject("AutoCAD.Application.17.1")
    Set docObj = acadApp.Application.Documents.Add
    If Err Then
        MsgBox ("无法运行AutoCAD2008，请检查是否安装了AutoCAD2008")
        Exit Sub
    End If
End If

' 连接至 AutoCAD 图形
Dim acadDoc As AcadDocument
Set acadDoc = acadApp.ActiveDocument
acadApp.Visible = True

 ' 绘制椭圆弧

Dim ellObj As AcadEllipse
Dim majAxis(0 To 2) As Double
Dim center(0 To 2) As Double
Dim radRatio As Double

'创建椭圆弧，起始角度0°，终止角度180°
center(0) = 0
center(1) = 0
center(2) = 0
majAxis(0) = 10
majAxis(1) = 0
majAxis(2) = 0
radRatio = 0.5
Set ellObj = acadDoc.ModelSpace.AddEllipse(center, majAxis, radRatio)
ellObj.StartAngle = 0 * (3.14159 / 180)
ellObj.EndAngle = 180 * (3.14159 / 180)

ZoomExtents

绘制一个中心点center(0,0,0)，长半轴majAxis(0)为10（相对于中心的增量），长短轴比值radRatio为0.5的椭圆，起点角度0°，终止角度180°。效果如下：

5：绘制样条曲线

代码如下：

' 本例在模型空间中创建样条曲线对象。
' 声明所需的变量
Dim splineObj As AcadSpline
Dim startTan(0 To 2) As Double
Dim endTan(0 To 2) As Double
Dim fitPoints(0 To 8) As Double

' 定义变量
startTan(0) = 0.5: startTan(1) = 0.5: startTan(2) = 0
endTan(0) = 0.5: endTan(1) = 0.5: endTan(2) = 0
fitPoints(0) = 1: fitPoints(1) = 1: fitPoints(2) = 0
fitPoints(3) = 5: fitPoints(4) = 5: fitPoints(5) = 0
fitPoints(6) = 10: fitPoints(7) = 0: fitPoints(8) = 0

' 创建样条曲线
Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
ZoomAll