[例程]三维实体
Public Sub CreateExtrPathSolid()'本过程演示沿给定路径挤出实体
'设定线框模型的轮廓线数
ThisDrawing.SetVariable "ISOLINES", 10
' ---------------------------------------------
Dim curves(0 To 1) As AcadEntity
Dim centerPoint(0 To 2) As Double
Dim radius As Double
Dim startAngle As Double
Dim endAngle As Double
centerPoint(0) = 125#: centerPoint(1) = 75#: centerPoint(2) = 0#
radius = 50#
startAngle = 0
endAngle = 3.141592
'创建一个半圆弧
Set curves(0) = ThisDrawing.ModelSpace.AddArc _
(centerPoint, radius, startAngle, endAngle)
'创建连接圆弧两端的直线段
Set curves(1) = ThisDrawing.ModelSpace.AddLine _
(curves(0).StartPoint, curves(0).EndPoint)
'由封闭的半圆生成区域
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
regionObj(0).Color = acCyan
'---------------------------------------------------------
'用B样条曲线作为挤出路径
'Dim splineObj As AcadSpline
'Dim startTan(0 To 2) As Double
'Dim endTan(0 To 2) As Double
'Dim noOfPoints As Integer
'Dim fitPoints(0 To 8) As Double
'startTan(0) = 0: startTan(1) = 0: startTan(2) = 0
'endTan(0) = 0: endTan(1) = 0: endTan(2) = 0
'fitPoints(0) = 0: fitPoints(1) = 0: fitPoints(2) = 0
'fitPoints(3) = 100: fitPoints(4) = 100: fitPoints(5) = 150
'fitPoints(6) = 250: fitPoints(7) = 100: fitPoints(8) = 250
'noOfPoints = 3
'创建作为挤出路径的B样条曲线
'Set splineObj = ThisDrawing.ModelSpace.AddSpline _
(fitPoints, startTan, endTan)
'------------------------------------------------------------
'用3D多义线作为挤出路径
Dim polyObj As Acad3DPolyline
Dim points(0 To 8) As Double
'设定构成挤出路径的坐标点
points(0) = 0: points(1) = 0: points(2) = 0
points(3) = 0: points(4) = 0: points(5) = 150
points(6) = 250: points(7) = 150: points(8) = 151
'创建作为挤出路径的3D多义线
Set polyObj = ThisDrawing.ModelSpace.Add3DPoly(points)
'-------------------------------------------------------------
'通过创建好的区域生成3D实体
Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath _
(regionObj(0), polyObj)
solidObj.Color = acRed
'改变观察方向
Dim NewDirection(0 To 2) As Double
NewDirection(0) = 1: NewDirection(1) = 1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ZoomAll
End Sub
Public Sub CreateExtrSolid()
'本过程演示挤出实体的生成
'如果ISOLINES系统变量的值小于20，将其设为20
Dim isoline As Integer
isoline = ThisDrawing.GetVariable("ISOLINES")
If isoline < 20 Then
ThisDrawing.SetVariable "ISOLINES", 20
End If
Dim curves(0 To 1) As AcadEntity '存放轮廓线图元的对象变量
'定义有关的圆弧变量
Dim centerPoint(0 To 2) As Double
Dim radius As Double
Dim startAngle As Double
Dim endAngle As Double
centerPoint(0) = 125#: centerPoint(1) = 75#: centerPoint(2) = 0#
radius = 50#
startAngle = 0
endAngle = 3.141592
'生成圆弧
Set curves(0) = ThisDrawing.ModelSpace.AddArc _
(centerPoint, radius, startAngle, endAngle)
'生成与圆弧两个端点连接的直线
Set curves(1) = ThisDrawing.ModelSpace.AddLine _
(curves(0).StartPoint, curves(0).EndPoint)
'创建由圆弧和直线形成的区域
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
'声明和赋值挤出变量
Dim height As Double
Dim taperAngle As Double
height = 75
taperAngle = 0
'创建挤出实体
Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolid _
(regionObj(0), height, taperAngle)
'改变观察方向
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ZoomAll
End Sub
Public Sub CreateRevSolid()
'本过程演示旋转实体的生成
Dim curves(0 To 1) As AcadEntity
'声明有关创建圆弧的变量
Dim centerPoint(0 To 2) As Double
Dim radius As Double
Dim startAngle As Double
Dim endAngle As Double
'给圆弧变量赋值
centerPoint(0) = 125#: centerPoint(1) = 75#: centerPoint(2) = 0#
radius = 50#
startAngle = 0
endAngle = 3.141592
'绘制圆弧段
Set curves(0) = ThisDrawing.ModelSpace.AddArc _
(centerPoint, radius, startAngle, endAngle)
'绘制直线段
Set curves(1) = ThisDrawing.ModelSpace.AddLine _
(curves(0).StartPoint, curves(0).EndPoint)
'创建由圆弧和直线段构成的区域
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
regionObj(0).Color = acCyan
ZoomAll
'--------------------------------------------------------------------
'准备生成旋转轴线
Dim axisPt(0 To 2) As Double
Dim axisDir(0 To 2) As Double
Dim angle As Double
Dim lineObj As AcadLine
Dim sPnt(0 To 2) As Double, ePnt(0 To 2) As Double
axisPt(0) = 175: axisPt(1) = 62.5: axisPt(2) = 0
axisDir(0) = 275: axisDir(1) = 25: axisDir(2) = 75
angle = 6.28 '旋转角为360度
sPnt(0) = 50: sPnt(1) = 50: sPnt(2) = 0
ePnt(0) = 250: ePnt(1) = 75: ePnt(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(sPnt, ePnt)
lineObj.Color = acGreen
'----------------------------------------------------------
'创建旋转实体
Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddRevolvedSolid _
(regionObj(0), axisPt, axisDir, angle)
'将旋转实体设为红色
solidObj.Color = acRed
ZoomAll
'改变观察方向
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
End Sub
Public Sub BooleanResults()
'本过程演示实体间进行布尔操作的结果
ThisDrawing.SetVariable "ISOLINES", 10
'为创建第1个柱体声明对象变量和参数变量
Dim cylObj1 As Acad3DSolid
Dim cylCenter(0 To 2) As Double
Dim cylRadius As Double
Dim cylHeight As Double
cylCenter(0) = 0#: cylCenter(1) = 0#: cylCenter(2) = 0#
cylRadius = 100#
cylHeight = 420#
'创建第2个柱体
Set cylObj1 = ThisDrawing.ModelSpace.AddCylinder _
(cylCenter, cylRadius, cylHeight)
'为创建第2个柱体声明对象变量和参数变量
Dim cylObj2 As Acad3DSolid
cylCenter(0) = 0#: cylCenter(1) = 0#: cylCenter(2) = 0#
cylRadius = 125#
cylHeight = 500#
'创建第2个柱体
Set cylObj2 = ThisDrawing.ModelSpace.AddCylinder _
(cylCenter, cylRadius, cylHeight)
'为创建第3个柱体声明对象变量和参数变量
Dim cylObj3 As Acad3DSolid
cylCenter(0) = 0#: cylCenter(1) = 0#: cylCenter(2) = 0#
cylRadius = 90#
cylHeight = 420#
'创建第3个柱体
Set cylObj3 = ThisDrawing.ModelSpace.AddCylinder _
(cylCenter, cylRadius, cylHeight)
'声明创建转动轴的2个点数组变量
Dim point1(0 To 2) As Double, point2(0 To 2) As Double
'将第2个柱体绕位于YZ平面内的轴转动90度
point1(0) = 0: point1(1) = -210: point1(2) = 0
point2(0) = 0: point2(1) = 210: point2(2) = 0
cylObj2.Rotate3D point1, point2, 3.1415926 / 2
'将第3个柱体绕位于XY平面内的轴转动90度
point1(0) = -210: point1(1) = 0: point1(2) = 0
point2(0) = 210: point2(1) = 0: point2(2) = 0
cylObj3.Rotate3D point1, point2, 3.1415926 / 2
'改变观察方向
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ZoomAll
'将3个柱体进行布尔运算
'cylObj2.Boolean acSubtraction, cylObj1
'cylObj2.Boolean acSubtraction, cylObj3
'cylObj1.Boolean acUnion, cylObj2 '第1与第2柱体并运算
'cylObj1.Boolean acUnion, cylObj3 '再与第3柱体并运算
cylObj1.Boolean acUnion, cylObj2 '第1与第2柱体并运算
cylObj1.Boolean acSubtraction, cylObj3 '再与第3柱体差运算
ThisDrawing.Regen True
End Sub
Public Sub SliceSolid()
'本过程演示实体的剖切
ThisDrawing.SetVariable "ISOLINES", 15
'声明创建盒子的对象变量与有关的参数变量
Dim boxObj As Acad3DSolid
Dim length As Double, width As Double, height As Double
Dim center(0 To 2) As Double
center(0) = 0#: center(1) = 0#: center(2) = 0
length = 70#: width = 70: height = 70#
'在模型空间绘制Box实体
Set boxObj = ThisDrawing.ModelSpace.AddBox _
(center, length, width, height)
'------------------------------------
'用于创建区域的图元对象数组变量
Dim curves(0 To 1) As AcadEntity
'声明有关创建圆弧的变量
Dim centerPoint(0 To 2) As Double
Dim radius As Double
Dim startAngle As Double
Dim endAngle As Double
'给圆弧变量赋值
centerPoint(0) = 0#: centerPoint(1) = 0#: centerPoint(2) = 0#
radius = 30#
startAngle = 0
endAngle = 3.141592
'绘制圆弧段
Set curves(0) = ThisDrawing.ModelSpace.AddArc _
(centerPoint, radius, startAngle, endAngle)
'绘制直线段
Set curves(1) = ThisDrawing.ModelSpace.AddLine _
(curves(0).StartPoint, curves(0).EndPoint)
'创建由圆弧和直线段构成的区域
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
'准备生成旋转轴线
Dim axiS As Variant, axiE As Variant
Dim axiDir(0 To 2) As Double
Dim angle As Double
axiS = curves(0).EndPoint '将圆弧的终点作为旋转轴的起点
'圆弧起点与终点坐标之差，构成旋转轴的方向增量
axiE = curves(0).StartPoint
axiDir(0) = axiE(0) - axiS(0)
axiDir(1) = axiE(1) - axiS(1)
axiDir(2) = axiE(2) - axiS(2)
angle = 6.28 '旋转角为360度
'生成旋转实体
Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddRevolvedSolid _
(regionObj(0), axiS, axiDir, angle)
'盒子实体差掉旋转实体
boxObj.Boolean acSubtraction, solidObj
curves(0).Delete '删除半圆弧段
curves(1).Delete '删除直线段
regionObj(0).Delete '删除扇形区域
'---------------------------------------------
'声明组成剖切面的3个点数组变量
Dim slicePt1(0 To 2) As Double
Dim slicePt2(0 To 2) As Double
Dim slicePt3(0 To 2) As Double
'剖切面定义成YZ平面
slicePt1(0) = 0: slicePt1(1) = 75: slicePt1(2) = 0
slicePt2(0) = 0: slicePt2(1) = -75: slicePt2(2) = -100
slicePt3(0) = 0: slicePt3(1) = -75: slicePt3(2) = 100
'剖切经布尔运算以后的盒子实体
Dim sliceObj As Acad3DSolid
Set sliceObj = boxObj.SliceSolid(slicePt1, slicePt2, slicePt3, True)
sliceObj.Delete '保留剖切的Box实体
ThisDrawing.Regen True
'改变观察方向
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
'ZoomAll
'直接运行AutoCAD的 HIDE 命令
ThisDrawing.SendCommand "_hide" & vbCr
End Sub
Public Sub CheckInference()
'本过程演示对实体间干涉的检验
'声明创建Box的对象变量及有关参数变量。
Dim boxObj As Acad3DSolid
Dim boxLength As Double, boxWidth As Double, boxHeight As Double
Dim boxCenter(0 To 2) As Double
boxCenter(0) = 125#: boxCenter(1) = 125#: boxCenter(2) = 0
boxLength = 250#: boxWidth = 175: boxHeight = 250#
'在模型空间生成Box实体
Set boxObj = ThisDrawing.ModelSpace.AddBox _
(boxCenter, boxLength, boxWidth, boxHeight)
'声明创建Cylinder的对象变量及有关参数变量
Dim cylinderObj As Acad3DSolid
Dim cylinderCenter(0 To 2) As Double
Dim cylinderRadius As Double
Dim cylinderHeight As Double
cylinderCenter(0) = 0#
cylinderCenter(1) = 0#
cylinderCenter(2) = 0#
cylinderRadius = 125#
cylinderHeight = 400#
'在模型空间生成Cylinder实体
Set cylinderObj = ThisDrawing.ModelSpace.AddCylinder _
(cylinderCenter, cylinderRadius, cylinderHeight)
'声明干涉实体对象变量
Dim solidObj As Acad3DSolid
'检查是否有干涉，如有则生成干涉实体
Set solidObj = boxObj.CheckInterference(cylinderObj, True)
solidObj.Color = acRed '将干涉实体设成红色
'改变观察方向
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ZoomAll
End Sub
页:
[1]