VB语言在CAD上计算机辅助几何设计习题汇编

创建点对象

Sub ch4_createpoint()

Dim pointobj As AcadPoint

Dim location(0 To 2) As Double

'定义点的位置

location(0) = 5#: location(1) = 5#: location(2) = 0#

'创建点

Set pointobj = ThisDrawing.ModelSpace.AddPoint(location) ThisDrawing.SetVariable "PDMODE", 34

ThisDrawing.SetVariable "PDSIZE", 1

ZoomAll

End Sub

打开图形

Sub ch3_opendrawing()

Dim dwgname As String

dwgname = "c:\campus.dwg"

If Dir(dwgname) <> "" Then

ThisDrawing.Application.Documents.Open dwgname Else

MsgBox "file" & " does not exist."

End If

End Sub

创建多段线

Sub Ch4_AddLightWeightPolyline()

Dim plineObj As AcadLWPolyline

Dim points(0 To 5) As Double

' 定义二维多段线的点

points(0) = 2: points(1) = 4

points(2) = 4: points(3) = 2

points(4) = 6: points(5) = 4

' 在模型空间中创建一个优化多段线对象

Set plineObj = ThisDrawing.ModelSpace. _

AddLightWeightPolyline(points) ThisDrawing.Application.ZoomAll

End Sub

创建和命名图层

Sub ch4_newlayer()

' 创建圆

Dim circleobj As AcadCircle

Dim center(0 To 2) As Double

Dim radius As Double

center(0) = 2: center(1) = 2: center(2) = 0

radius = 1

Set circleobj = ThisDrawing.ModelSpace. _

AddCircle(center, radius)

'创建颜色对象

Dim col As New AcadAcCmColor

col.ColorMethod = AutoCAD.acColorMethodForeground

'设置图层的颜色

Dim laycolor As AcadAcCmColor

Set laycolor = AcadApplication.GetInterfaceObject("autocad.accmcolor.16") Call laycolor.SetRGB(122, 199, 25)

ThisDrawing.ActiveLayer.turecolor = laycolor

col.ColorMethod = AutoCAD.acColorMethodByLayer

'将圆的颜色指定为"随层"

'以便圆自动拾取所在图层的

'颜色

circleobj.color = acByLayer

circleobj.Update

End Sub

创建面域

Sub Ch4_CreateRegion()

' 定义保存面域边界

' 的数组

Dim center(0 To 2) As Double

Dim radius As Double

center(0) = 2

center(1) = 2

center(2) = 0

radius = 5#

Set curves(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)

' 创建面域

Dim regionObj As Variant

regionObj = ThisDrawing.ModelSpace.AddRegion(curves) ZoomAll

End Sub

创建曲线

Sub Ch4_CreateSpline()

' 本例在模型空间中创建样条曲线对象。

' 声明所需的变量

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

End Sub

创建直线

Sub Example_AddLine()

' This example adds a line in modle space

Dim lineObj As AcadLine

Dim startPoint(0 To 2) As Double

Dim endPoint(0 To 2) As Double

' Define the start and end points for the line