第六章 在三维空间中工作
大部分图形都是由三维对象的二维视图组成的。虽然这种绘图方法在建筑设计和工程设计领域被广泛应用，但却具有一定的局限性，即图形是三维对象的二维表示，必须进行视觉化的解释。而且，由于视图是分别绘制的，因此很有可能出现错误或表达不清楚。有鉴于此，用户可能会希望创建真正的三维模型，而不仅仅是二维表示。使用 AutoCAD® 的绘图工具可以创建真实、详尽的三维对象，并且能够以多种方式对其进行处理。
6.1 指定三维坐标
输入三维 WCS 坐标与输入二维 WCS 坐标类似，只是除了指定 X 和 Y 值以外，还要指定 Z 值。与二维坐标相同，可以使用变量向 ActiveX 方法和属性传递坐标，以及查询坐标。
示例:本样例创建两条多段线，每条都有三个坐标。第一条是二维多段线，第二条是三维多段线。注意，创建三维多段线时，包含顶点的数组的长度会扩充以包含 Z 坐标。然后，样例查询多段线的坐标，并将坐标显示在消息框中。
Sub Ch8_Polyline_2D_3D()
Dim pline2DObj As AcadLWPolyline Dim pline3DObj As AcadPolyline Dim points2D(0 To 5) As Double Dim points3D(0 To 8) As Double ' 定义三个二维多段线点
points2D(0) = 1: points2D(1) = 1 points2D(2) = 1: points2D(3) = 2 points2D(4) = 2: points2D(5) = 2 ' 定义三个三维多段线点
points3D(0) = 1: points3D(1) = 1: points3D(2) = 0 points3D(3) = 2: points3D(4) = 1: points3D(5) = 0 points3D(6) = 2: points3D(7) = 2: points3D(8) = 0 ' 创建二维优化多段线
Set pline2DObj = ThisDrawing.ModelSpace. AddLightWeightPolyline(points2D) pline2DObj.Color = acRed pline2DObj.Update ' 创建三维多段线
Set pline3DObj = ThisDrawing.ModelSpace. AddPolyline(points3D) pline3DObj.Color = acBlue pline3DObj.Update ' 查询多段线的坐标 Dim get2Dpts As Variant Dim get3Dpts As Variant
get2Dpts = pline2DObj.Coordinates get3Dpts = pline3DObj.Coordinates ' 显示坐标
MsgBox (\"2D polyline (red): \" & vbCrLf & _
get2Dpts(0) & \
中国测友
get2Dpts(2) & \ MsgBox (\"3D polyline (blue): \" & vbCrLf & _
get3Dpts(0) & \ get3Dpts(2) & vbCrLf & _
get3Dpts(3) & \
get3Dpts(5) & vbCrLf & get3Dpts(6) & \End Sub
6.2 定义用户坐标系
定义用户坐标系 ( UCS) 对象以更改 (0, 0, 0) 原点的位置以及 XY 平面和 Z 轴的方向。可以在三维空间中的任意位置放置 UCS 并定义其方向，并且可以定义、保存和调用所需任意数目的用户坐标系。坐标的输入和显示均相对于当前 UCS。
要标明 UCS 的原点和方向，请使用 UCSIconAtOrigin 属性，在 UCS 原点处显示 UCS 图标。如果已打开 UCS 图标（请参见 UCSIconOn 属性）但没有显示在原点，则该图标是显示在 UCSORG 系统变量定义的 WCS 坐标处。
可以使用 Add 方法创建新的用户坐标系。该方法需要四个输入值：原点坐标、X 和 Y 轴上的坐标以及 UCS 的名称。
在 AutoCAD ActiveX Automation 中，所有坐标都是以世界坐标系 (WCS) 输入的。使用 GetUCSMatrix 方法可以返回给定 UCS 的转换矩阵。由此转换矩阵可以找出等价的 WCS 坐标。
要激活 UCS 坐标系，请使用 Document 对象的 ActiveUCS 属性。如果对活动 UCS 进行更改，则必须将新的 UCS 对象重置为活动的 UCS 才能显示所做的更改。要重置活动的 UCS，只需再次调用更新的 UCS 对象的 ActiveUCS 属性即可。
下面的子例程将创建新的 UCS，并将其设置为图形的活动 UCS。然后要求用户在图形中拾取一点，并返回该点的 WCS 和 UCS 坐标。
Sub Ch8_NewUCS() ' 定义所需的变量
Dim ucsObj As AcadUCS Dim origin(0 To 2) As Double Dim xAxisPnt(0 To 2) As Double Dim yAxisPnt(0 To 2) As Double ' 定义 UCS 点
origin(0) = 4: origin(1) = 5: origin(2) = 3
xAxisPnt(0) = 5: xAxisPnt(1) = 5: xAxisPnt(2) = 3 yAxisPnt(0) = 4: yAxisPnt(1) = 6: yAxisPnt(2) = 3 ' 将 UCS 添加到
' UserCoordinatesSystems 集合
Set ucsObj = ThisDrawing.UserCoordinateSystems. Add(origin, xAxisPnt, yAxisPnt, \"New_UCS\") ' 显示 UCS 图标
ThisDrawing.ActiveViewport.UCSIconAtOrigin = True ThisDrawing.ActiveViewport.UCSIconOn = True ' 使新的 UCS 成为活动的 UCS ThisDrawing.ActiveUCS = ucsObj
MsgBox \"The current UCS is : \" & ThisDrawing.ActiveUCS.Name _ & vbCrLf & \" Pick a point in the drawing.\" ' 找出某一点的 WCS 和 UCS 坐标
中国测友
Dim WCSPnt As Variant Dim UCSPnt As Variant
WCSPnt = ThisDrawing.Utility.GetPoint(, \"Enter a point: \")
UCSPnt = ThisDrawing.Utility.TranslateCoordinates(WCSPnt, acWorld, acUCS, False) MsgBox \"The WCS coordinates are: \" & WCSPnt(0) & \ & WCSPnt(1) & \ \"The UCS coordinates are: \" & UCSPnt(0) & \ & UCSPnt(1) & \End Sub
6.3 转换坐标
TranslateCoordinates 方法可以将点或位移从一个坐标系转换到另一个坐标系。称为 OriginalPoint 的点参数可以被解释为三维点或三维位移矢量。此参数由 Boolean 参数 Disp 来区分。如果 Disp 参数设置为 TRUE，OriginalPoint 参数将被视为位移矢量；否则视为点。还有两个参数用于确定 OriginalPoint 来自哪个坐标系以及要转换到哪个坐标系。可以在 From 和 To 参数中指定以下 AutoCAD 坐标系：
．WCS
世界坐标系 - 参照坐标系。所有其他坐标系都相对于 WCS 定义，该坐标系恒定不变。相对于 WCS 测量的值可以稳定地转换到其他坐标系中。除非另行指定，ActiveX 方法和属性传入和传出的所有点都以 WCS 表示。
．UCS
用户坐标系 - 工作坐标系。用户可以指定 UCS 以方便执行绘图任务。所有传递到 AutoCAD 命令的点，包括从 AutoLISP 例程以及外部函数返回的点，都是当前 UCS 中的点（除非用户于命令提示中在点之前加上了 *）。如果希望应用程序以 WCS、OCS 或 DCS 向 AutoCAD 命令发送坐标，必须先调用 TranslateCoordinates 方法，将这些坐标转换为 UCS。
．OCS
对象坐标系 - 由 Polyline 和 LightweightPolyline 对象的某些方法和属性指定的点值以此坐标系表示（相对于对象）。根据对象的用途，这些点通常会转换为 WCS、当前 UCS 或当前 DCS。相对地，WCS、UCS 或 DCS 中的点在使用相同的属性写入数据库之前，必须将其转换为 OCS。关于采用此坐标系的方法和属性，请参见 AutoCAD ActiveX and VBA Reference Guide。
将坐标转换到 OCS 或从 OCS 转换坐标时，必须在 TranslateCoordinates 函数的最后一个参数中输入 OCS 的法线。
．DCS
显示坐标系 - 在显示对象之前将对象转换到的坐标系。DCS 的原点是存储在 AutoCAD 系统变量 TARGET 中的点，Z 轴是观察方向。也就是说，某个视口始终是其 DCS 的一个平面视图。这些坐标可用于确定显示给 AutoCAD 用户的画面的位置。
．PSDCS
图纸空间 DCS - 此坐标系只能与当前活动的模型空间视口的 DCS 互相转换。这种转换实质上是一种二维转换，其中的 X 和 Y 坐标在 Disp 参数设置为 FALSE 时，始终要进行缩放和偏移。Z 坐标也要缩放，但并不转换。因此，它可用于确定两个坐标系之间的缩放比例。PSDCS 只能转换到当前的模型空间视口中。如果 from 参数等于 PSDCS，则 to 参数必须等于 DCS，反之亦然。
本样例在模型空间中创建一条多段线。然后，以 OCS 和 WCS 坐标显示多段线的第一个顶点。从 OCS 转换为 WCS 时，需要在 TranslateCoordinates 方法的最后一个参数中提供 OCS 法线。
Sub Ch8_TranslateCoordinates() ' 在模型空间中创建多段线。 Dim plineObj As AcadPolyline
中国测友
Dim points(0 To 14) As Double ' 定义二维多段线的点
points(0) = 1: points(1) = 1: points(2) = 0 points(3) = 1: points(4) = 2: points(5) = 0 points(6) = 2: points(7) = 2: points(8) = 0 points(9) = 3: points(10) = 2: points(11) = 0 points(12) = 4: points(13) = 4: points(14) = 0 ' 在模型空间中创建优化多段线对象
Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points) ' 找出多段线第一个顶点的 ' X 和 Y 坐标
Dim firstVertex As Variant
firstVertex = plineObj.Coordinate(0) ' 使用 elevation 属性找出多段线 ' 的 Z 坐标
firstVertex(2) = plineObj.Elevation ' 更改多段线的法线，使 ' 坐标系之间的差值 ' 更加明显。
Dim plineNormal(0 To 2) As Double plineNormal(0) = 0# plineNormal(1) = 1# plineNormal(2) = 2#
plineObj.Normal = plineNormal ' 将 OCS 坐标转换为 WCS Dim coordinateWCS As Variant
coordinateWCS = ThisDrawing.Utility.TranslateCoordinates _ (firstVertex, acOCS, acWorld, False, plineNormal) ' 显示点的坐标
MsgBox \"The first vertex has the following coordinates:\" _ & vbCrLf & \"OCS: \" & firstVertex(0) & \ firstVertex(1) & \ertex(2) & vbCrLf & _ \"WCS: \" & coordinateWCS(0) & \
coordinateWCS(1) & \End Sub
6.4 创建三维对象
AutoCAD 支持三种类型的三维建模：线框模型、曲面模型和实体模型。每种模型都有自己的创建方法和编辑技术。
6.4.1 创建线框
使用 AutoCAD，可以通过将任意二维平面对象放置在三维空间中的任意位置来创建线框模型。可以使用多种方法在三维空间中放置二维对象：
．通过输入三维点来创建对象。输入坐标，定义点的 X、Y 和 Z 位置。 ．设置默认的构造平面（XY 平面），用于在上面定义 UCS 并绘制对象。
中国测友．创建之后，在三维空间中将该对象移至适当方向。
此外，还可以创建具有三个维度的线框对象（例如多段线）。可以使用 Add3DPoly 方法创建三维多段线。
6.4.2 创建网格
矩形网格（ PolygonMesh 对象）使用平面镶嵌面来表示对象的曲面。网格密度（或镶嵌面的数目）由包含 M 乘 N 个顶点的矩阵定义，类似于由行和列组成的栅格。M 和 N 分别指定给定顶点的列和行的位置。在二维和三维空间中都可以创建网格，但它主要用于三维空间。
使用 Add3DMesh 方法可以创建矩形网格。该方法需要三个输入值：M 方向的顶点数、N 方向的顶点数和包含网格中所有顶点的坐标的变量数组。
创建 PolygonMesh 之后，可以使用 MClose 和 NClose 属性来结束网格。
本样例创建一个 4 × 4 的多边形网格。然后调整活动视口的方向，以便于查看网格的三维情况。 Sub Ch8_Create3DMesh()
Dim meshObj As AcadPolygonMesh Dim mSize, nSize, Count As Integer Dim points(0 To 47) As Double ' 创建点的矩阵
points(0) = 0: points(1) = 0: points(2) = 0 points(3) = 2: points(4) = 0: points(5) = 1 points(6) = 4: points(7) = 0: points(8) = 0 points(9) = 6: points(10) = 0: points(11) = 1 points(12) = 0: points(13) = 2: points(14) = 0 points(15) = 2: points(16) = 2: points(17) = 1 points(18) = 4: points(19) = 2: points(20) = 0 points(21) = 6: points(22) = 2: points(23) = 1 points(24) = 0: points(25) = 4: points(26) = 0 points(27) = 2: points(28) = 4: points(29) = 1 points(30) = 4: points(31) = 4: points(32) = 0 points(33) = 6: points(34) = 4: points(35) = 0 points(36) = 0: points(37) = 6: points(38) = 0 points(39) = 2: points(40) = 6: points(41) = 1 points(42) = 4: points(43) = 6: points(44) = 0 points(45) = 6: points(46) = 6: points(47) = 0 mSize = 4: nSize = 4
' 在模型空间中创建三维网格
Set meshObj = ThisDrawing.ModelSpace. Add3DMesh(mSize, nSize, points) ' 更改视口的观察方向 ' 以更好地查看圆柱体
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
6.4.3 创建多面网格
使用 AddPolyfaceMesh 方法可以创建多面网格，其中每个面都可以有很多顶点。
创建多面网格与创建矩形网格类似。要创建多面网格，首先为所有顶点指定坐标，然后通过输入每个面的所有顶点的顶点编号来定义每个面。创建多面网格时，可以将特定边设置为不可见、指定边所在的图层或边的颜色。
要使某个边不可见，可以为该边的顶点编号输入负值。关于创建多面网格的详细信息，请参见 ActiveX and VBA Reference Guide 中介绍的 AddPolyfaceMesh 方法。
本样例在模型空间中创建一个多面网格对象。然后更新活动视口的观察方向，以便于查看网格的三维情况。
Sub Ch8_CreatePolyfaceMesh() '定义网格顶点
Dim vertex(0 To 17) As Double
vertex(0) = 4: vertex(1) = 7: vertex(2) = 0 vertex(3) = 5: vertex(4) = 7: vertex(5) = 0 vertex(6) = 6: vertex(7) = 7: vertex(8) = 0 vertex(9) = 4: vertex(10) = 6: vertex(11) = 0 vertex(12) = 5: vertex(13) = 6: vertex(14) = 0 vertex(15) = 6: vertex(16) = 6: vertex(17) = 1 ' 定义面列表
Dim FaceList(0 To 7) As Integer FaceList(0) = 1 FaceList(1) = 2 FaceList(2) = 5 FaceList(3) = 4 FaceList(4) = 2 FaceList(5) = 3 FaceList(6) = 6 FaceList(7) = 5 ' 创建多面网格
Dim polyfaceMeshObj As AcadPolyfaceMesh
Set polyfaceMeshObj = ThisDrawing.ModelSpace.AddPolyfaceMesh (vertex, FaceList) ' 更改视口的观察方向 ' 以便于查看多面网格
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
6.4.4 创建实体
中国测友实体对象（ 3DSolid 对象）代表对象的整个体积。实体是信息最完整和最确切的三维建模类型。复杂实体形也比线框和网格更容易构造和编辑。
可以根据基本实体形（长方体、圆锥体、圆柱体、球体、圆环体和楔体）来创建实体，也可以通过沿路径拉伸二维对象或者绕轴旋转二维对象来创建实体。要创建实体，可以使用以下方法之一：
AddBox、 AddCone、 AddCylinder、 AddEllipticalCone、 AddEllipticalCylinder、 AddExtrudedSolid、 AddExtrudedSolidAlongPath、 AddRevolvedSolid、 AddSolid、 AddSphere、 AddTorus 或 AddWedge。
与网格相同，实体显示为线框，直至用户将其隐藏、着色或渲染。此外，用户还可以分析实体的质量属性（体积、惯性矩、重心等等）。以下属性可用于分析实体： MomentOfInertia、 PrincipalDirections、 PrincipalMoments、 ProductOfInertia、 RadiiOfGyration 和 Volume。
ContourlinesPerSurface 属性控制用于直观显示线框曲线部分的素线数目。 RenderSmoothness 属性调整着色和隐藏线对象的平滑度。
本样例在模型空间中创建一个楔形实体。然后更新活动视口的观察方向，以便于查看楔体的三维情况。 Sub Ch8_CreateWedge()
Dim wedgeObj As Acad3DSolid Dim center(0 To 2) As Double Dim length As Double Dim width As Double Dim height As Double ' 定义楔体
center(0) = 5#: center(1) = 5#: center(2) = 0 length = 10#: width = 15#: height = 20# ' 在模型空间中创建楔体
Set wedgeObj = ThisDrawing.ModelSpace. AddWedge(center, length, width, height) ' 更改视口的观察方向
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
6.5 在三维空间中编辑
6.5.1
在三维空间中旋转对象
使用 Rotate 方法可以在二维空间中绕指定点旋转对象。旋转的方向由 WCS 确定。而使用 Rotate3D 方法可以在三维空间中绕指定轴旋转对象。Rotate3D 方法需要三个输入值：定义旋转轴的两点的 WCS 坐标和以弧度为单位的旋转角度。
中国测友
要旋转三维对象，既可以使用 Rotate 方法，也可以使用 Rotate3D 方法。 本样例创建一个三维长方体，然后定义旋转轴，将长方体绕该轴旋转 30 度。 Sub Ch8_Rotate_3DBox()
Dim boxObj As Acad3DSolid Dim length As Double Dim width As Double Dim height As Double
Dim center(0 To 2) As Double ' 定义长方体
center(0) = 5: center(1) = 5: center(2) = 0 length = 5 width = 7 height = 10
' 在模型空间中创建长方体对象
Set boxObj = ThisDrawing.ModelSpace. AddBox(center, length, width, height) ' 用两点定义旋转轴
Dim rotatePt1(0 To 2) As Double Dim rotatePt2(0 To 2) As Double Dim rotateAngle As Double
rotatePt1(0) = -3: rotatePt1(1) = 4: rotatePt1(2) = 0 rotatePt2(0) = -3: rotatePt2(1) = -4: rotatePt2(2) = 0 rotateAngle = 30
rotateAngle = rotateAngle * 3.141592 / 180# ' 旋转长方体
boxObj.Rotate3D rotatePt1, rotatePt2, rotateAngle ZoomAll End Sub
6.5.2 在三维空间中创建阵列
使用 ArrayRectangular 方法可以在三维空间中创建矩形阵列。除了指定列数（X 方向）和行数（Y 方向）以外，还要指定层数（Z 方向）。
本样例创建一个圆，然后用该圆创建 4 行、4 列、3 层的圆的矩形阵列。 Sub Ch8_CreateRectangularArray() ' 创建圆
Dim circleObj As AcadCircle Dim center(0 To 2) As Double Dim radius As Double
中国测友6.5.3 在三维空间中镜像对象
使用 Mirror3D 方法可以沿三点指定的特定镜像平面来镜像对象。
本样例在模型空间中创建一个长方体，然后根据某个平面镜像该长方体，并将镜像得到的长方体着色为红色。
Sub Ch8_MirrorABox3D() ' 创建长方体对象
Dim boxObj As Acad3DSolid Dim length As Double Dim width As Double Dim height As Double
Dim center(0 To 2) As Double
center(0) = 5#: center(1) = 5#: center(2) = 0 length = 5#: width = 7: height = 10#
' 在模型空间中创建长方体 (3DSolid) 对象
中国测 center(0) = 2: center(1) = 2: center(2) = 0 radius = 0.5
Set circleObj = ThisDrawing.ModelSpace. AddCircle(center, radius) ' 定义矩形阵列
Dim numberOfRows As Long Dim numberOfColumns As Long Dim numberOfLevels As Long Dim distanceBwtnRows As Double Dim distanceBwtnColumns As Double Dim distanceBwtnLevels As Double numberOfRows = 4 numberOfColumns = 4 numberOfLevels = 3 distanceBwtnRows = 1 distanceBwtnColumns = 1 distanceBwtnLevels = 4 ' 创建对象的阵列 Dim retObj As Variant
retObj = circleObj.ArrayRectangular _
(numberOfRows, numberOfColumns, _ numberOfLevels, distanceBwtnRows, _
distanceBwtnColumns, distanceBwtnLevels) ZoomAll End Sub
友 Set boxObj = ThisDrawing.ModelSpace. AddBox(center, length, width, height) ' 用三个点定义镜像平面
Dim mirrorPt1(0 To 2) As Double Dim mirrorPt2(0 To 2) As Double Dim mirrorPt3(0 To 2) As Double
mirrorPt1(0) = 1.25: mirrorPt1(1) = 0: mirrorPt1(2) = 0 mirrorPt2(0) = 1.25: mirrorPt2(1) = 2: mirrorPt2(2) = 0 mirrorPt3(0) = 1.25: mirrorPt3(1) = 2: mirrorPt3(2) = 2 ' 镜像长方体
Dim mirrorBoxObj As Acad3DSolid
Set mirrorBoxObj = boxObj.Mirror3D (mirrorPt1, mirrorPt2, mirrorPt3) mirrorBoxObj.Color = acRed ZoomAll End Sub
6.5.4 编辑三维实体
创建实体之后，可以通过组合实体来创建更复杂的形状。可以合并这些实体、获得它们的差集或找出实体的公用（重叠）部分。可以使用 Boolean 或 CheckInterference 方法完成这些组合。
' 定义圆柱体
Dim cylinderObj As Acad3DSolid Dim cylinderRadius As Double Dim cylinderHeight As Double
center(0) = 0: center(1) = 0: center(2) = 0 cylinderRadius = 5 cylinderHeight = 20 ' 创建圆柱体并 ' 着色为青色
Set cylinderObj = ThisDrawing.ModelSpace.AddCylinder(center, cylinderRadius, cylinderHeight) cylinderObj.Color = acCyan ' 找出两个实体之间的干涉
' 并由干涉创建新的实体。新实体 ' 着色为红色。
Dim solidObj As Acad3DSolid
Set solidObj = boxObj.CheckInterference(cylinderObj, True) solidObj.Color = acRed ZoomAll End Sub
本样例在模型空间中创建一个长方体，然后基于由三个点定义的平面剖切该长方体。剖切后的结果作为 3DSolid 返回。
Sub Ch8_SliceABox() ' 创建长方体对象
Dim boxObj As Acad3DSolid Dim length As Double Dim width As Double Dim height As Double
Dim center(0 To 2) As Double
center(0) = 5#: center(1) = 5#: center(2) = 0 length = 5#: width = 7: height = 10#
' 在模型空间中创建长方体 (3DSolid) 对象
Set boxObj = ThisDrawing.ModelSpace. AddBox(center, length, width, height) boxObj.Color = acWhite ' 用三点定义剖切平面
Dim slicePt1(0 To 2) As Double Dim slicePt2(0 To 2) As Double Dim slicePt3(0 To 2) As Double
slicePt1(0) = 1.5: slicePt1(1) = 7.5: slicePt1(2) = 0 slicePt2(0) = 1.5: slicePt2(1) = 7.5: slicePt2(2) = 10 slicePt3(0) = 8.5: slicePt3(1) = 2.5: slicePt3(2) = 10 ' 剖切长方体并将新实体着色为红色 Dim sliceObj As Acad3DSolid
Set sliceObj = boxObj.SliceSolid (slicePt1, slicePt2, slicePt3, True) sliceObj.Color = acRed ZoomAll
中国测友
End Sub
中国测友
因篇幅问题不能全部显示，请点此查看更多更全内容