29、AutoCAD绘图技巧：对象分组与3D实体创建

AutoCAD对象分组与3D实体创建

emacs5lisp

于 2025-11-21 15:09:33 发布

阅读量5

点赞数

CC 4.0 BY-SA版权

分类专栏：掌握AutoCAD VBA编程文章标签： AutoCAD 对象分组 3D实体创建

本文链接：https://blog.youkuaiyun.com/emacs5lisp/article/details/155259753

掌握AutoCAD VBA编程专栏收录该内容

34 篇文章 ¥499.90

订阅专栏¥69.90

会员秒杀 ¥9.9 重磅福利

超级会员免费看

AutoCAD绘图技巧：对象分组与3D实体创建

1. 位值说明

在绘图过程中，有一些位值会影响输入和显示的规则，以下是具体的位值及其描述：
| 位值 | 描述 |
| ---- | ---- |
| 0 | 无 |
| 1 | 不允许空输入（如用户按回车键或空格键） |
| 2 | 不允许零值 |
| 4 | 不允许负值 |
| 8 | 允许用户选择当前绘图区域外的点 |
| 16 | 当前未使用 |
| 32 | 当用户遵循Utility方法显示的提示时，以虚线绘制橡皮筋线和框 |
| 64 | 从GetDistance方法返回x和y分量，忽略三维对象的z分量 |
| 128 | 不加质疑地接受用户的任何字符串输入 |

2. 使用组

AutoCAD提供了Groups集合，可将对象组合在一起，类似于创建选择集，但组对象更持久。组与块有相似之处，但组的优势在于可以使用AppendItem和RemoveItem方法单独添加和删除其对象。

2.1 创建新组

Groups集合的Add方法用于创建新组，Item方法用于通过名称或索引值从集合中访问现有组对象。以下是创建组的示例代码：

Public Sub AddAGroup()
    Dim GroupObject As AcadGroup
    Dim ObjectsForGroup() As AcadEntity
    Dim CircleObject As AcadCircle
    Dim LineObject As AcadLine
    Dim Center(0 To 2) As Double, Radius As Double
    Dim StartPoint(0 To 2) As Double
    Dim EndPoint(0 To 2) As Double
    Dim Count As Integer
    Center(0) = 1#: Center(1) = 1#: Center(2) = 0#
    Radius = 1.5
    Set CircleObject = ThisDrawing.ModelSpace.AddCircle(Center, Radius)
    StartPoint(0) = Center(0): StartPoint(1) = Center(1): StartPoint(2) = Center(2)
    EndPoint(0) = Center(0) + Radius + 0.5: EndPoint(1) = Center(1): EndPoint(2) = Center(2)
    Set LineObject = ThisDrawing.ModelSpace.AddLine(StartPoint, EndPoint)
    ReDim ObjectsForGroup(0 To ThisDrawing.ModelSpace.Count - 1) As AcadEntity
    For Count = 0 To ThisDrawing.ModelSpace.Count - 1
        Set ObjectsForGroup(Count) = ThisDrawing.ModelSpace.Item(Count)
    Next
    Set GroupObject = ThisDrawing.Groups.Add("MyGroup")
    GroupObject.AppendItems ObjectsForGroup
    GroupObject.Color = acBlue
    GroupObject.Highlight True
    ThisDrawing.Regen acActiveViewport
    ZoomAll
End Sub

2.2 代码分析

第1行：开始AddAGroup宏，创建Line和Circle对象并将它们添加到组中。
第2行：声明GroupObject变量，用于引用Group对象。
第3行：声明ObjectsForGroup数组，用于包含可引用Entity对象的元素。
第4 - 5行：声明用于引用Circle和Line对象的变量。
第6行：声明数组，用于分配圆的中心坐标和半径。
第7 - 8行：声明数组，用于保存定义线的两个端点。
第9行：声明Count作为For循环的计数器变量。
第10 - 11行：分配定义圆中心位置和半径的值。
第12行：调用AddCircle方法创建新的Circle对象。
第13 - 14行：分配定义线的两个端点的坐标值。
第15行：调用AddLine方法创建新的线。
第16行：重新定义ObjectsForGroup数组，使其足够大以包含与ModelSpace对象关联的对象数量。
第17 - 19行：使用For循环将Model Space中的对象引用分配给ObjectsForGroup数组的元素。
第20行：调用Groups集合的Add方法创建新的Group对象，并将其添加到集合中。
第21行：调用AppendItems方法将ObjectsForGroup数组中的绘图对象添加到”MyGroup”组中。
第22行：将组的Color属性设置为蓝色。
第23行：调用Highlight属性，将参数设置为True，以突出显示组成员。
第24行：调用Regen方法重新生成活动视口。
第25行：调用ZoomAll方法确保显示所有绘图对象。
第26行：结束AddAGroup宏。

2.3 访问组中的单个绘图对象

使用组对象可以访问单个绘图对象并更新其属性。例如，要将图中的线从蓝色更新为绿色，只需在上述代码的第24行插入以下语句：

GroupObject.Item(1).Color = acGreen

3. 创建3D实体

AutoCAD提供了多种方法来创建用于构造实体几何（CSG）技术的基本实体，可通过宏将这些实体添加到绘图中，并从不同方向查看它们。

3.1 3D实体类型

AutoCAD有一个通用类型Acad3DSolid，可以表示任何3D实体对象，如盒子、楔子、圆锥、圆柱、球体和圆环等。这些实体通常用于传统方法来构造复杂实体。

3.2 构建3D实体应用程序

以下是构建3D实体应用程序的步骤：
1. 启动新项目并添加一个UserForm。
2. 添加两个列表框，一个显示可用的实体类型，另一个显示当前绘图会话中添加的实体。
3. 在每个列表框上方放置一个标签，描述其内容。
4. 创建三个命令按钮：添加实体、删除已添加的实体和结束应用程序并返回AutoCAD窗口。
5. 将UserForm和控件的属性更改为以下值：
| 旧名称 | 新名称 | 标题 |
| ---- | ---- | ---- |
| UserForm1 | frmBuildSolids | Build 3D Solids |
| ListBox1 | lslSolidTypes | — |
| ListBox2 | lstSolidsAdded | — |
| Label1 | — | Solid Types |
| Label2 | — | Solids Added |
| CommandButton1 | cmdAdd | Add |
| CommandButton2 | cmdDelete | Delete |
| CommandButton3 | cmdFinish | Finish |
6. 将cmdAdd的Accelerator属性更改为A，cmdDelete更改为D，cmdFinish更改为F。
7. 输入GUI的事件过程代码：

Private Sub cmdAdd_Click()
    frmBuildSolids.hide
    Select Case lstSolidTypes.ListIndex
    Case 0
        ThisDrawing.DrawBox
        lstSolidsAdded.AddItem "Box"
    Case 1
        ThisDrawing.DrawWedge
        lstSolidsAdded.AddItem "Wedge"
    Case 2
        ThisDrawing.DrawSphere
        lstSolidsAdded.AddItem "Sphere"
    Case 3
        ThisDrawing.DrawTorus
        lstSolidsAdded.AddItem "Torus"
    Case 4
        ThisDrawing.DrawCone
        lstSolidsAdded.AddItem "Cone"
    Case 5
        ThisDrawing.DrawEllipticalCone
        lstSolidsAdded.AddItem "Cone (elliptical)"
    Case 6
        ThisDrawing.DrawCylinder
        lstSolidsAdded.AddItem "Cylinder"
    Case 7
        ThisDrawing.DrawEllipticalCylinder
        lstSolidsAdded.AddItem "Cylinder (elliptical)"
    End Select
    frmBuildSolids.Show
End Sub

Private Sub cmdDelete_Click()
    If lstSolidsAdded.ListIndex = -1 Then 'no solid selected
        MsgBox "Please select item from the Solids Added listbox.", vbOKOnly, "Building 3D Solids"
    Else
        ThisDrawing.ModelSpace.Item(lstSolidsAdded.ListIndex).Delete
        lstSolidsAdded.RemoveItem (lstSolidsAdded.ListIndex)
        ThisDrawing.Regen acActiveViewport
    End If
End Sub

Private Sub cmdFinish_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    lstSolidTypes.AddItem "Box"
    lstSolidTypes.AddItem "Wedge"
    lstSolidTypes.AddItem "Sphere"
    lstSolidTypes.AddItem "Torus"
    lstSolidTypes.AddItem "Cone (circular)"
    lstSolidTypes.AddItem "Cone (elliptical)"
    lstSolidTypes.AddItem "Cylinder (circular)"
    lstSolidTypes.AddItem "Cylinder (elliptical)"
End Sub

输入ChangeViewDirection宏的代码：

Public Sub ChangeViewDirection()
    Dim ViewDirection(0 To 2) As Double
    ViewDirection(0) = 3#
    ViewDirection(1) = -2.5
    ViewDirection(2) = 1.5
    ThisDrawing.ActiveViewport.Direction = ViewDirection
    ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
End Sub

3.3 创建不同类型的3D实体

3.3.1 创建盒子

以下是创建盒子的代码：

Public Sub DrawBox()
    'draws a box
    Dim BoxObject As Acad3DSolid
    Dim BoxCenter(0 To 2) As Double
    Dim BoxLength As Double, BoxWidth As Double
    Dim BoxHeight As Double
    Dim CornerPoint As Variant
    With ThisDrawing.Utility
        CornerPoint = .GetPoint(, vbCr & "Select the position of a corner of the box:")
        BoxLength = .GetDistance(CornerPoint, vbCr & "Enter the distance along the X-axis:")
        BoxWidth = .GetDistance(CornerPoint, vbCr & "Enter the distance along the Y-axis:")
        BoxHeight = .GetDistance(CornerPoint, vbCr & "Enter the distance along the Z-axis:")
    End With
    BoxCenter(0) = CornerPoint(0) + BoxWidth / 2#
    BoxCenter(1) = CornerPoint(1) + BoxHeight / 2#
    BoxCenter(2) = CornerPoint(2) + BoxLength / 2#
    ChangeViewDirection
    Set BoxObject = ThisDrawing.ModelSpace.AddBox(BoxCenter, BoxLength, BoxWidth, BoxHeight)
    BoxObject.Update
End Sub

创建盒子的步骤如下：
1. 输入DrawBox宏代码。
2. 在optBox的骨架Click事件过程中输入 ThisDrawing.DrawBox 。
3. 从AutoCAD窗口的宏对话框运行宏，或从Visual Basic编辑器运行。
4. 按照命令行提示输入所需的位置和尺寸。

3.3.2 创建楔子

创建楔子的代码如下：

Public Sub DrawWedge()
    'draws a wedge
    Dim WedgeObject As Acad3DSolid
    Dim WedgeLength As Double, WedgeWidth As Double
    Dim WedgeHeight As Double
    Dim FaceCenterPoint As Variant
    With ThisDrawing.Utility
        FaceCenterPoint = .GetPoint(, vbCr & "Select the center of the sloping face:")
        WedgeLength = .GetDistance(FaceCenterPoint, vbCr & "Enter the distance along the X-axis:")
        WedgeWidth = .GetDistance(FaceCenterPoint, vbCr & "Enter the distance along the Y-axis:")
        WedgeHeight = .GetDistance(FaceCenterPoint, vbCr & "Enter the distance along the Z-axis:")
    End With
    ChangeViewDirection
    Set WedgeObject = ThisDrawing.ModelSpace.AddWedge(FaceCenterPoint, WedgeLength, WedgeWidth, WedgeHeight)
    WedgeObject.Update
End Sub

创建楔子的步骤如下：
1. 将DrawWedge宏的代码添加到代码窗口。
2. 从AutoCAD窗口的宏对话框运行宏。
3. 按照命令行提示输入所需的位置和尺寸。

3.3.3 创建球体

创建球体的代码如下：

Public Sub DrawSphere()
    'draws a sphere
    Dim SphereObject As Acad3DSolid
    Dim SphereCenter As Variant
    Dim SphereRadius As Double
    With ThisDrawing.Utility
        SphereCenter = .GetPoint(, vbCr & "Select position for center of sphere:")
        SphereRadius = .GetDistance(SphereCenter, vbCr & "Enter radius of Sphere:")
    End With
    ThisDrawing.Preferences.ContourLinesPerSurface = 12
    Set SphereObject = ThisDrawing.ModelSpace.AddSphere(SphereCenter, SphereRadius)
    SphereObject.Update
    ChangeViewDirection
End Sub

创建球体的步骤如下：
1. 输入DrawSphere宏的代码。
2. 从AutoCAD窗口的宏对话框运行宏。
3. 按照命令行提示输入球体的中心和位置。

3.3.4 创建圆环

创建圆环的代码如下：

Public Sub DrawTorus()
    'draws a torus
    Dim TorusObject As Acad3DSolid
    Dim TorusCenter As Variant
    Dim TorusRadius As Double
    Dim TubeRadius As Double
    Dim PointOnRadius(0 To 2) As Double
    With ThisDrawing.Utility
        TorusCenter = .GetPoint(, vbCr & "Select position for center of Torus:")
        TorusRadius = .GetDistance(TorusCenter, vbCr & "Enter radius of Torus:")
        PointOnRadius(0) = TorusCenter(0) + TorusRadius
        PointOnRadius(1) = TorusCenter(1)
        PointOnRadius(2) = TorusCenter(2)
        TubeRadius = .GetDistance(PointOnRadius, vbCr & "Enter radius of tube:")
    End With
    ThisDrawing.Preferences.ContourLinesPerSurface = 12
    Set TorusObject = ThisDrawing.ModelSpace.AddTorus(TorusCenter, TorusRadius, TubeRadius)
    TorusObject.Update
    ChangeViewDirection
End Sub

创建圆环的步骤如下：
1. 输入DrawTorus宏的代码。
2. 从AutoCAD窗口的宏对话框运行宏。
3. 按照命令行提示输入所需的信息。

3.3.5 创建圆锥

创建圆锥的代码如下：

Public Sub DrawCone()
    'draws a cone
    Dim ConeObject As Acad3DSolid
    Dim ConeCenter As Variant
    Dim ConeRadius As Double
    Dim ConeHeight As Double
    With ThisDrawing.Utility
        ConeCenter = .GetPoint(, vbCr & "Select position for base of cone:")
        ConeRadius = .GetDistance(ConeCenter, vbCr & "Enter radius of base:")
        ConeHeight = .GetDistance(ConeCenter, vbCr & "Enter height of cone:")
    End With
    ConeCenter(2) = ConeCenter(2) + ConeHeight / 2#
    Set ConeObject = ThisDrawing.ModelSpace.AddCone(ConeCenter, ConeRadius, ConeHeight)
    ConeObject.Update
    ChangeViewDirection
End Sub

创建圆锥的步骤如下：
1. 输入DrawCone宏的代码。
2. 从AutoCAD窗口的宏对话框运行宏。
3. 按照命令行提示输入所需的位置和尺寸。

3.3.6 创建圆柱

创建圆柱的代码如下：

Public Sub DrawCylinder()
    'draws a cylinder
    Dim CylinderObject As Acad3DSolid
    Dim CylinderCenter As Variant
    Dim CylinderRadius As Double
    Dim CylinderHeight As Double
    With ThisDrawing.Utility
        CylinderCenter = .GetPoint(, vbCr & "Select position for center of base:")
        CylinderRadius = .GetDistance(CylinderCenter, vbCr & "Enter radius of cylinder:")
        CylinderHeight = .GetDistance(CylinderCenter, vbCr & "Enter height of Cylinder:")
    End With
    ThisDrawing.Preferences.ContourLinesPerSurface = 12
    CylinderCenter(2) = CylinderCenter(2) + CylinderHeight / 2#
    Set CylinderObject = ThisDrawing.ModelSpace.AddCylinder(CylinderCenter, CylinderRadius, CylinderHeight)
    CylinderObject.Update
    ChangeViewDirection
End Sub

创建圆柱的步骤如下：
1. 输入DrawCylinder宏的代码。
2. 从AutoCAD窗口的宏对话框运行宏。
3. 按照命令行提示输入所需的位置和尺寸。

3.3.7 创建椭圆圆锥

创建椭圆圆锥的代码如下：

Public Sub DrawEllipticalCone()
    'draw elliptical cone
    Dim ConeObject As Acad3DSolid
    Dim ConeCenter As Variant
    Dim ConeXDistance As Double, ConeYDistance As Double
    Dim ConeHeight As Double
    With ThisDrawing.Utility
        ConeCenter = .GetPoint(, vbCr & "Select position for center of base:")
        ConeXDistance = .GetDistance(ConeCenter, vbCr & "Enter X distance of base:")
        ConeYDistance = .GetDistance(ConeCenter, vbCr & "Enter Y distance of base:")
        ConeHeight = .GetDistance(ConeCenter, vbCr & "Enter height of cone:")
    End With
    ThisDrawing.Preferences.ContourLinesPerSurface = 20
    ConeCenter(2) = ConeCenter(2) + ConeHeight / 2#
    Set ConeObject = ThisDrawing.ModelSpace.AddEllipticalCone(ConeCenter, ConeXDistance, ConeYDistance, ConeHeight)
    ConeObject.Update
    ChangeViewDirection
End Sub

创建椭圆圆锥的步骤如下：
1. 输入DrawEllipticalCone宏的代码。
2. 从AutoCAD窗口的宏对话框运行宏。
3. 按照命令行提示输入所需的位置和尺寸。

3.3.8 创建椭圆圆柱

创建椭圆圆柱的代码如下：

Public Sub DrawEllipticalCylinder()
    'draw elliptical cylinder
    Dim CylinderObject As Acad3DSolid
    Dim CylinderCenter As Variant
    Dim CylinderXDistance As Double, CylinderYDistance As Double
    Dim CylinderHeight As Double
    With ThisDrawing.Utility
        CylinderCenter = .GetPoint(, vbCr & "Select position for center of base:")
        CylinderXDistance = .GetDistance(CylinderCenter, vbCr & "Enter X distance for cylinder:")
        CylinderYDistance = .GetDistance(CylinderCenter, vbCr & "Enter Y distance for cylinder:")
        CylinderHeight = .GetDistance(CylinderCenter, vbCr & "Enter height of Cylinder:")
    End With
    ThisDrawing.Preferences.ContourLinesPerSurface = 12
    CylinderCenter(2) = CylinderCenter(2) + CylinderHeight / 2#
    Set CylinderObject = ThisDrawing.ModelSpace.AddEllipticalCylinder(CylinderCenter, CylinderXDistance, CylinderYDistance, CylinderHeight)
    CylinderObject.Update
    ChangeViewDirection
End Sub

创建椭圆圆柱的步骤如下：
1. 输入DrawEllipticalCylinder宏的代码。
2. 从AutoCAD窗口的宏对话框运行宏。
3. 按照命令行提示输入所需的位置和尺寸。

通过以上步骤和代码，你可以在AutoCAD中实现对象分组和创建各种3D实体。这些技巧可以帮助你更高效地进行绘图工作，满足不同的设计需求。

4. 3D 实体创建的其他操作

4.1 添加轮廓线

通过更新 ContourLinesPerSurface 属性，可以调整每个表面的线条数量。例如，在创建圆锥时，若要增加轮廓线数量，可在创建圆锥代码的第 10 行后插入以下语句：

ThisDrawing.Preferences.ContourLinesPerSurface = 20

当运行 DrawCone 宏时，当前绘图中的任何圆锥和其他实体以及未来添加的实体都将生成额外的轮廓线。

4.2 3D 实体创建流程总结

下面通过 mermaid 流程图展示 3D 实体创建的整体流程：

graph TD;
    A[启动新项目并添加 UserForm] --> B[添加列表框和标签];
    B --> C[创建命令按钮];
    C --> D[更改属性];
    D --> E[输入 GUI 事件过程代码];
    E --> F[输入 ChangeViewDirection 宏代码];
    F --> G[选择要创建的实体类型];
    G --> H{是否创建特定实体};
    H -- 是 --> I[输入对应实体创建宏代码];
    I --> J[运行宏并按提示输入信息];
    J --> K[完成实体创建];
    H -- 否 --> G;

5. 总结与注意事项

5.1 总结

通过上述内容，我们掌握了 AutoCAD 中对象分组和 3D 实体创建的相关技巧：
- 了解了位值的含义和作用，可根据需求设置输入和显示规则。
- 学会使用 Groups 集合创建和管理对象组，能方便地操作组内对象。
- 掌握了创建各种 3D 实体的方法，包括盒子、楔子、球体等，并能根据需要调整实体的位置、尺寸和轮廓线数量。

5.2 注意事项

组命名 ：在创建组时，若多次运行创建组的宏，需使用不同的组名，否则会出现“组已存在”的错误信息。
列表框索引 ：在使用列表框选择实体进行添加或删除操作时，要确保正确处理列表框的索引值，避免出现未选择实体或索引越界的问题。
视图更新 ：对视图方向或实体属性进行更改后，需确保视图更新以显示更改效果，可通过调用 Regen 方法或重新激活视口来实现。

5.3 技巧扩展

代码复用 ：可以将相似的实体创建代码进行整合，通过添加判断条件来实现不同类型实体的创建，提高代码的复用性。例如，将 DrawCone 和 DrawEllipticalCone 的代码合并，通过提示用户选择是否为椭圆实体来决定使用不同的参数。
用户交互优化 ：可以进一步优化用户界面，添加更多的提示信息和错误处理，提高用户体验。例如，在用户输入无效的尺寸值时，给出明确的错误提示并要求重新输入。

通过不断练习和探索，你可以更加熟练地运用这些技巧，提高 AutoCAD 绘图的效率和质量，满足各种复杂的设计需求。希望这些内容对你的绘图工作有所帮助！