[例程]三维实体

mccad

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