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

通过三点 (0,0,0)、(5,5,0) 和 (10,0,0) 在模型空间中创建样条曲线。该样条曲线的起点切向和端点切向为 (0.5,0.5,0)。效果如下:

版权声明:
作者:胡伟明
链接:https://www.huweiming.cn/2022/11/966.html
来源:胡伟明
文章版权归作者所有,未经允许请勿转载。

THE END
分享
二维码
< <上一篇
下一篇>>
文章目录
关闭
目 录