VBA 开发指南

本指南包含以下主题：

  • VBA 入门
  • ActiveX Automation 基础
  • 创建中望CAD 对象
  • 编辑中望CAD 对象
  • 高级应用
  • VBA 示例程序
  • VBA 移植指南


VBA 入门

本章主要介绍了VBA 简介、VBA 管理器、 VBA宏命令对话框、VBA IDE 编辑器、VBA工程及命令、VBA语言概述、简单示例。内容如下：

  • VBA 简介
  • VBA 管理器
  • VBA 宏命令对话框
  • VBA IDE 编辑器
  • VBA 工程及命令
  • VBA 语言概述
  • 简单实例


VBA 简介

VBA 是 Visual Basic for Application 简称，它是为 Microsoft Windows 应用程序提供的宏程序设计语言，因此 Microsoft Windows 系统下的一些应用程序，包括 Microsoft Office 系列下的 Word、Excel 和 PowerPoint 等都支持这种语言。VBA 的强大开发功能与易用性相结合，与 VB 一样，VBA 也是一种面向对象的、可视化的、事件驱动的高级程序设计语言。VBA 的语法、功能甚至开发环境跟VB都是基本相同的，可以说 VBA 是 VB 的一个子集。但是 VB 具有自己的开发环境，而且 VB 开发出的应用程序最终是编译成二进制可执行文件（*.EXE），而 VBA 通常寄生于已有的应用程序，以代码文本方式存在，不需要编译，只需要通过应用程序中的 VBA 解释器进行解释运行，Word、Excel 等支持VBA宏语言的应用程序，都带有 VBA 的编辑器和解释器。

简单来说，中望CAD 提供了一个系统环境支持 VBA 语言的解释器运行。中望CAD 专业版本也同样是一个支持 VBA 宏语言的应用程序，提供了一套专用于中望CAD 平台上的 VBA 接口，通过调用中望CAD 专业版平台所提供的VBA接口库，可以对中望CAD 平台进行控制和扩展，也就是我们通常所说的二次开发。中望CAD 所提供的 COM 接口，遵循COM接口定义标准，所以不仅仅是VBA语言，其它一些支持自动化的编程语言，都可以通过自动化调用中望CAD 的 COM 接口，从而实现对中望CAD 平台功能的控制和扩展，这种方式跟其它一些支持 VBA 的应用程序是一致的。

相对于其它一些二次开发方式（如Lisp），在中望CAD 中利用VBA进行二次开发有以下的优点：

  • VBA 语法易于学习，容易掌握。
  • 中望CAD 专业版带有一个功能非常强大的 VBA 编辑器，可以对宏进行逐步调试及对代码的运行进行监控查看，提高二次开发的效率。
  • 对话框的构造快速而有效，这使开发人员可以构造原型应用程序并迅速收到设计的反馈。


VBA 管理器

使用 VBA 管理器可以查看当前中望CAD 任务中加载的所有 VBA 工程，可让用户加载、卸载、保存、新建 VBA 工程。

可以通过 “工具”»“宏”»“VBA 管理器”菜单项或者在命令行输入“VBAMAN”打开 VBA 管理器。“VBA 管理器”对话框如图：

本节包含如下内容：

  • 加载工程
  • 卸载工程
  • 新建工程
  • 保存工程
  • 修改工程名称


加载工程

将工程加载到中望CAD 后，就可以使用其中所有的宏。每当用户加载工程时，都会弹出对话框提示用户选择是启用还是禁用工程中的代码，以此作为防范病毒的措施。当用户启用了代码，则代码中的病毒就可以开始执行。如果用户禁用，则可以加载工程，但是不能运行代码。

同时可以在启动中望CAD 的时候自动加载工程文件，自动加载工程文件有以下两种方式：

  • 把文件名修改为 Zwcad.zvb，并放在中望CAD 可以搜索的范围的路径下。
  • 将VBA 工程文件添加到中望CAD 的启动组来实现自动加载。

加载 VBA 工程文件的步骤

  1. 在命令行输入“VBAMAN”或者通过中望CAD 菜单“工具”»“宏”»“VBA 管理器”。
  2. 打开“VBA 管理器”对话框，点击“加载”按钮打开“打开VBA工程”对话框，选择需要加载的工程文件。

用户还可以在命令行输入“VBALOAD”或“-VBALOAD”来加载工程文件。


卸载工程

通过卸载工程可以释放内存，提高计算机使用率并且易于管理工程。

卸载 VBA 工程的步骤：

  1. 通过中望CAD 菜单“工具”»“宏”»“VBA 管理器”或者命令行输入“VBAMAN”命令打开“VBA 管理器”对话框。

  2. 选择需要卸载的文件并点击“卸载”按钮可以卸载 VBA 工程，或者在命令行输入“VBAUNLOAD”也可以卸载工程。


新建工程

新建的工程是没有保存的，创建完成后可以通过另存为将它保存。

新建 VBA 工程的步骤：

  1. 通过中望CAD 菜单“工具”»“宏”»“VBA 管理器”或者命令行输入“VBAMAN”命令打开“VBA 管理器”对话框点击“新建”按钮可以新建工程。
  2. 新工程将用默认的名称 ZWCADProject 创建。要更改工程名，必须进入 VBA IDE 中在“特性”窗口中设置。


保存工程

可以通过 VBA 管理器或 VBA IDE 来保存已有工程。

用 VBA 管理器保存工程的步骤

  1. 通过中望CAD 菜单“工具”>>“宏”>>“VBA 管理器”，并选择要保存的工程。
  2. 点击“另存为”按钮，将会保存工程。


修改工程名称

工程名称可以在 VBA IDE 中的“特性”窗口中修改。通过打开 VBA IDE 的“工程资源管理器”窗口，选择要更改的工程在“特性”窗口中修改 Name 属性。“特性”窗口如下图：


VBA宏命令对话框

计算科学里的宏是一种抽象，它根据一系列预定义的规则替换一定的文本模式。中望CAD 自动集成了 VBA 高级程序语言，用该语言编制出来的程序就叫“宏”。

本节包含如下内容：

  • 处理宏


处理宏

通过中望CAD 菜单“工具”»“宏”»“宏”或者在命令行中输入“VBARUN”打开“宏”对话框，在该对话框中用户可以创建、编辑、删除、运行宏，“宏”对话框如下：

创建新宏的步骤

  • 打开“宏”对话框，在“宏位于”下拉列表中选择需要创建宏的工程，在“宏名称”文本框中输入宏名，点击“创建”按钮。

删除宏的步骤

  • 打开“宏”对话框，选中需要删除的宏点击“删除”按钮，宏被删除前会提示用户是否删除宏。

运行宏的步骤

  • 打开“宏”对话框，点击“运行”按钮。或者从 VBA IDE 运行宏，从菜单选择“运行”»“运行宏”。

编辑宏的步骤

  • 打开“宏”对话框选择需要编辑的宏，点击“编辑”按钮进入 VBA IDE，并在“代码”窗口中打开选中的宏。

单步执行宏的步骤

  • 打开“宏”对话框选择需要执行的宏，点击“逐语句”按钮开始执行宏，然后在第一行代码处中止执行。


VBA IDE 编辑器

在 VBA IDE 中可以查看所有已经加载的工程，并且可以编辑和调试工程中的代码和窗体。VBA IDE 包含了“工程资源管理器”窗口，以树形结构来显示所有已经加载的工程列表。“工程资源管理器”窗口还显示代码、类和窗体以及工程的实际路径，“工程资源管理器” 窗口也有自己的工具栏可以编辑各个组件，通过“查看代码”、“查看对象”按钮分别可以打开选定模块的代码和显示选定的对象，“切换文件”按钮让树形结构以不同的方式显示。默认情况下，“工程资源管理器”窗口是可见的。如果 VBA IDE上没有显示，那么可以通过 VBA IDE 菜单“视图”»“工程资源管理器”或者 Ctrl+R 组合键来显示。

“工程资源管理器”窗体如下：

每个工程包含了很多不同的组件，其中包含对象、窗体、标准模块、类模块、引用。对象组件表示 VBA 代码访问的当前中望CAD 图形。窗体（具有 .Frm 文件扩展名）是程序界面的窗口，或用作从用户处收集消息的对话框。标准模块（具有 .Bas 文件扩展名）可以包含类型、常数变量、外部过程和公共过程的公共或模块级的声明。类模块（具有 .Cls 文件扩展名）与窗体模块类似，只是没有可见的用户界面。可以使用类模块创建含有方法和属性的对象。标准模块和类模块均在“代码”窗口中编辑，“代码”窗口包含两个下拉列表、一个拆分栏、一个边界指示器栏、一个“完全视图”和“过程视图”图标。如果想了解详细信息，请参考 Microsoft 提供的 Visual Basic 帮助文档。“代码”窗口如下：

窗体在“用户窗体”窗口中使用特殊的工具箱进行编辑，“用户窗体”窗口和“工具箱”如下：

打开 VBA IDE 的步骤

  • 在命令行中输入“VBAIDE”或者“VBA”，或从菜单“工具”中依次选择“宏”»“Visual Basic 编辑器”。

向工程中添加新组件的步骤

  • 打开 VBA IDE 的“工程资源管理器”窗口，从“插入”菜单中可以选择插入“用户窗体”、“模块”或“类模块”来向工程中添加组件。

向工程中导入现有组件的步骤

  • 打开 VBA IDE 从菜单“文件”»“导入文件”，选择先前导出的文件导入当前工程。


VBA工程及命令

中望CAD VBA工程由代码模块、类模块和窗体组成，在这些组件中编写代码并运行可以实现给定的功能。工程保存在独立的 .zvb 文件中，用户可以随时将工程加载到当前的中望CAD 任务中。中望CAD 中VBA命令和工程术语如下：

VBA 命令和工程术语 | 含义
VBA/VBAIDE | 激活 VBA IDE，通过 VBA IDE 可以编辑、运行、调试程序
VBALOAD/-VBALOAD | 加载 VBA 工程到中望CAD 中
VBARUN/VBARUN | 在中望CAD 中运行 VBA 宏
VBAUNLOAD | 卸载中望CAD 中 VBA 工程
VBAMAN | 显示 VBA 管理器
Project | 存在 .zvb 文件中的 VBA 工程
ThisDrawing | VBA 编程术语，用来表示当前的图形


VBA 语言概述

VBA是非常流行的应用程序开发语言Visual Basic的子集，实际上VBA是“寄生于”VB应用程序的版本，VBA和VB区别如下几个方面：

  1. VB是设计用于创建标准的应用程序，而VBA是使已有的应用程序自动化。
  2. VB具有自己的开发环境，而VBA必须寄生于已有的应用程序。
  3. 要运行VB开发的应用程序，用户不必安装VB，因为VB开发出的应用程序是可执行文件（*.EXE），而VBA开发的程序必须依赖它的“父”应用程序。

本节包含如下内容：

  • 定义、赋值语句
  • 条件语句
  • 循环语句
  • 函数、过程语句


定义、赋值语句

DIM 语句

使用 Dim 语句或其它的声明语句之一（Public、Private或Static）去声明对象变量。引用对象的变量必须是 Variant、Object，或是一个对象的指定类型。例如，下列声明是有效的：

  • 声明 Temp为Variant数据类型：Dim Temp as Variant
  • 声明 MyObject为Object数据类型：Dim MyObject as Object
  • 声明 Center为Double数据类型：Dim Center(0 To 2) as Double

SET 语句

使用 Set 语句可以赋值一个对象给对象变量。可以赋值对象表达式或 Nothing。例如下列的对象变量赋值是有效的：

  • Set MyObject = YourOjbect '赋值对象引用
  • Set Myobject = Nothing '中断关联

可以同时使用 New 关键字和 Set 语句来声明对象变量，并赋值给对象给变量

  • Set MyObject = New Object '创建和赋值


条件语句

IF...Then...Else语句

根据条件的值，可使用If...Then...Else语句运行指定的语句或一个语句块。IF...Then...Else语句可以根据需要嵌套多级。然而，为了可读性可能会使用Select Case 语句而不使用多嵌套的If...Then...Else语句。使用If...Then...Else语句可以定义两个可执行的语句块,其中一个块会在条件为True时执行；而另一个块会在条件为False时执行。下列的示例显示了语法：

Sub test()

    Dim x As Double
    Dim y As Double

    If x < 0 Then
        y = x + 1
    Else
        y = x
    End If

End Sub

Select Case语句

当一个表达式与几个不同的值相比较时，可以使用Select Case语句来交替使用。在下面的示例中，Select Case语句会计算发送给此过程的参数performance。请注意，每个Case语句可以包含一个以上的值，一个值的范围，或是一个值的组合以及比较运算符。如果Select Case语句与Case语句的任何值不匹配，则可选的Case Else语句运行。下列的示例显示了语法：

Function Bonus(performance, salary)

    Select Case performance
        Case 1
            Bonus = salary * 0.1
        Case 2, 3
            Bonus = salary * 0.09
        Case 4 To 6
            Bonus = salary * 0.07
        Case Is > 8
            Bonus = 100
        Case Else
            Bonus = 0
    End Select

End Function


循环语句

For Each...Next语句

For Each...Next语句会重复一个语句块，而它是作用于集合中的每个对象或是数组中的每个元素。当循环执行一次则Visual Basic会自动设置一个变量。 下面的代码会在数组的每个元素中循环，并且将每个值设置成它的索引变量I的值。下列的示例显示了语法：

Dim TestArray(10) As Integer
Dim I As Variant

For Each I In TestArray
   TestArray(I) = I
Next I

Do...Loop语句

可以使用Do...Loop语句去运行语句的块，而它所用掉的时间是不确定的。当条件为True或直到条件变成True时，此语句会一直重复。 在下面的TestLoop过程中，在进入循环之前检查条件。如果将myNum的值由20替换成9，则循环中的语句将永远不会运行。下列的示例显示了语法：

Sub TestLoop()
    counter = 0
    myNum = 20
    Do While myNum > 10
       myNum = myNum - 1
       counter = counter + 1
    Loop
    MsgBox "The loop made " & counter & " repetitions."
End Sub


函数、过程语句

Function函数

Function函数是一系列由Function和End Function语句所包含起来的Visual Basic语句组成。Function函数和Sub过程很类似，但函数可以返回一个值。Function通过调用者传递参数，例如常数、变量、或是表达式等来调用它。如果一个Function过程没有参数，它的Function语句必须包含一个空的圆括号。函数会在过程的一个或多个语句中指定一个参数给函数名称来返回值。下列的示例显示了语法：

Public Function fact(x As Long) As Long

     Dim i As Long
     Dim t As Long
     t = 1
     For i = 1 To x
        t = t * i
     Next
     fact = t

End Function

Sub过程

过程是一系列由Sub和End Sub语句所包含起来的Visual Basic语句，它们会执行动作却不能返回一个值。Sub过程可有参数，例如常数、变量、或是表达式等来调用它。如果一个Sub过程没有参数，则它的Sub语句必须包含一个空的圆括号。下列的示例显示了语法：

Sub TestLoop ()
     Dim counter As Integer
     Dim myNum As Integer
     counter = 0
     myNum = 20
     Do While myNum > 10
        myNum = myNum - 1
        counter = counter + 1
     Loop
     MsgBox “The loop made “ & counter & “ repetitions.”
End Sub


简单实例

通过前面对中望CAD VBA 基本知识的了解，下面编写一个简单实例“DrawLine”让大家对 VBA 程序有一个认识，逐步了解 VBA。这个实例的功能是在当前的 DWG 图形中画一条直线，并保存名称为“Line.dwg”图纸。

Sub DrawLine()

    ThisDrawing.Application.Documents.Add  '添加新的文档
    Dim lineobject As ZcadLine             '声明直线对象
    Dim startPoint(0 To 2) As Double        '声明直线的起点
    Dim endPoint(0 To 2) As Double          '声明直线的终点

    startPoint(0) = 1  '设置起点的X坐标
    startPoint(1) = 1  '设置起点的Y坐标
    startPoint(2) = 0  '设置起点的Z坐标

    endPoint(0) = 100  '设置终点的X坐标
    endPoint(1) = 100  '设置终点的Y坐标
    endPoint(2) = 0    '设置终点的Z坐标

    '创建Line对象
    Set lineobject = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    lineobject.Color=ZcRed  '设置直线的颜色为红色
    lineobject.update
    ThisDrawing.Regen
    ThisDrawing.SaveAs("Line.dwg")  '保存DWG文件

End Sub

执行完程序后，您应该能够在图纸中看到颜色为红色的直线，图纸的名称为“Line.dwg”。


ActiveX Automation 基础

熟悉与要开发的应用程序类型相关的中望CAD 图元、对象和功能，可以高效的使用中望CAD ActiveX Automation。了解越深入，通过中望CAD ActiveX Automation 来操作这些特性就越简单。本章内容如下：

  • 对象层次结构
  • 集合对象的概念
  • 操作集合对象
  • 中望CAD 常用 VBA 接口


对象层次结构

VBA 通过 ThisDrawing 对象提供指向当前中望CAD 任务中活动图形的链接。用户使用 ThisDrawing，可以快速访问当前的 Document 对象及其所有方法和属性，还可以访问层次结构中的其他对象。

用户可以直接或者间接来引用对象。要直接引用对象，请将对象包含在调用层次结构中。例如，在模型空间中添加一个圆。结构是从 ThisDrawing 开始，再到 ModelSpace 对象，然后调用方法 AddCircle。

Sub Example_AddCircle()

    ’创建圆对象
    Dim circleObj As ZcadCircle
    Dim centerPoint(0 To 2) As Double
    Dim radius As Double
    centerPoint(0) = 10#: centerPoint(1) = 10#: centerPoint(2) = 0#
    radius = 10#
    Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
    ThisDrawing.Regen
    ThisDrawing.Application.ZoomAll

End Sub

用户要间接引用对象，首先声明变量，然后把引用的对象赋值给变量。例如，在模型空间中创建圆。定义类型为 ZwcadModelSpace 的变量 Mobject 并将其设置为当前模型空间，然后调用方法 AddCircle。

Sub Example_AddCircle()

    ’创建圆对象
    Dim Mobject As ZcadModelSpace
    Dim circleObj As ZcadCircle
    Dim centerPoint(0 To 2) As Double
    Dim radius As Double

    centerPoint(0) = 10#: centerPoint(1) = 10#: centerPoint(2) = 0#
    radius = 10#
    Set Mobject = ThisDrawing.ModelSpace
    Set circleObj = Mobject.AddCircle(centerPoint, radius)
    ThisDrawing.Regen
    ThisDrawing.Application.ZoomAll

End Sub


集合对象的概念

集合对象是一种预定义的对象，包含相似对象的所有实例。以下是集合对象的列表

集合名称 | 集合的含义
Documents | 包含当前中望CAD 打开的所有文档
ModelSpace | 包含模型空间中的所有图形对象
PaperSpace | 包含活动图纸空间布局中的所有图形对象
Blocks | 包含特定块定义中的所有图元
Dictionaries | 包含图形中的所有词典
DimStyles | 包含图形中的所有标注样式
Groups | 包含图形中的所有编组
Hyperlinks | 包含给定图元的所有超链接
Layers | 包含图形中的所有图层
Layouts | 包含图形中的所有布局
Linetypes | 包含图形中的所有线型
PlotConfigurations | 包含图形中的命名打印设置
RegisteredApplications | 包含图形中的所有注册的应用程序
SelectionSets | 包含图形中的所有选择集
TextStyles | 包含图形中的所有文字样式
UCSs | 包含图形中的所有用户坐标系
Views | 包含图形中的所有视图
Viewports | 包含图形中的所有视口


操作集合对象

大部分的集合对象都是通过 Document 对象访问的。对于每一个集合对象，Document 对象都包含一个相应的属性。要向集合中添加新的成员，请使用 Add 方法。要删除集合中的对象请使用 Delete 方法。要选择集合对象的特定成员， 请使用 Item 方法，该方法需要一个标识符，通过标识符既可以是指定集合内项目位置的索引号，也可以是代表项目名称的字符串。如下，设置变量表示当前图形的 Layers 集合，并且遍历 Layers 集合。

Sub Exampel_Add_layer()
    ’创建新的图层，遍历文档中所有的图层并且显示其名称
    Dim Layercoll As ZcadLayers
    Dim newlayer1 As ZcadLayer
    Dim newlayer2 As ZcadLayer
    Dim i As Integer
    Dim msg As String

    Set Layercoll = ThisDrawing.Layers
    Set newlayer1 = Layercoll.Add("new_layer")
    Set newlayer2 = Layercoll.Add("test")
    For i = 0 To Layercoll.Count - 1
    msg = msg + Layercoll.Item(i).Name + vbCrLf
    Next
    MsgBox msg

End Sub

注意 由于遍历集合的时候仅仅是读操作，因此不能在遍历集合的同时对集合中的任意对象进行编辑操作。要想编辑集合中的对象请在遍历完成后再进行。


中望CAD 常用 VBA 接口

下面简单介绍下中望CAD 常用 VBA 接口,仅仅是让大家对中望CAD 中的对象、属性、方法有一个初步的认识。具体的用法和涵义可以参见中望CAD VBA 参考或者 VBA IDE 中的“对象浏览器”。

ZwcadApplication 接口

中望CAD 应用程序对象接口，可以通过此接口对当前中望CAD 平台应用程序对象进行操作和访问，在 VBA 中访问 Application 对象，通过 ThisDrawing.Application 方法访问。Application 对象的属性反映了主应用程序窗口的属性，可以通过改变 Application 对象的属性来改变主应用程序窗口的属性。Application 对象的方法可以加载或列出外部的应用程序和接口对象。

主要方法：

  • LoadDVB（ApplicationName as String）主要用来加载 VBA 应用程序，在ApplicationName 参数里面需要输入 VBA 应用程序的路径名。
  • LoadARX（ApplicationName as String）主要用来加载 ObjectARX 应用程序，在 ApplicationName 参数里需要输入 ARX 应用程序路径名。
  • ListArx（）主要是用来返回已经加载的 ObjectARX 应用程序。

ZwcadDocument 接口

中望CAD 的文档对象，可以通过此接口来操作和访问指定的 DWG 文档，如果在 VBA 编辑器中，可以通过 VBA 工程的 ThisDrawing 来访问当前活动文档。

主要方法：

  • Regen([Viewports As ZcWhichViewport = zcActiveViewport])主要用来重新生成视口，当参数 ZcWhichViewport=zcActiveViewport 时，只是会重新生成当前视口。当参数 ZcWhichViewport = zcAllViewports 时，重新生成文档的所有视口。
  • GetVariable(Name As String) 用来获得指定的系统变量值。Name参数为要输入的系统变量名 。
  • SetVariable(Name As String, Value) 用来给指定的系统变量设置新值。Name参数为要设置的系统变量名，Value 参数为系统变量的新值。
  • Save（）用来保存文档。
  • SaveAs(SaveFile As String, [Version As ZcFileVersions = ZcNative]) 使用不同的名字来保存文档，并且可选不同的版本。参数 SaveFile 为要保存的文件名，参数 ZcFileVersions 为要保存的文件版本。

主要属性：

  • Layers 代表文档的层集合。
  • ActiveLayer 代表当前活动的图层，新对象被创建时会被放在当前图层。
  • Linetypes 代表文档的线型类集合。
  • ActiveLinetype 代表画图所使用的当前线型类型。
  • TextStyles 代表文字样式类型集合。
  • ActiveTextStyle 代表画图所使用的当前文本类型。
  • DimensionStyles 代表标注样式。
  • ActiveDimStyle 代表活动的标注样式。
  • ModelSpace 代表模型空间里所有对象的集合。不可以建立和删除 ModelSpace 集合，因为在图里始终只能有一个 ModelSpace 集合。

ZcadBlock、ZcadModelSpace、ZcadPaperSpace 接口

ZcadBlock：有三种类型的块，简单块、引用块、布局块。简单块是一组对象的集合，这些对象可以组装起来形成单独的对象或块定义。可以在图形中插入、放大和旋转简单块。引用块是从另一个图形到当前图形的外部连接。只要原始图形改变引用也会被更新，布局块代表模型空间和图纸空间的几何排列。

ZcadModelSpace：ModelSpace 代表模型空间里所有对象的集合。ModelSpace 集合实际上是块，所以拥有块的一些属性。

ZcadPaperSpace：这个集合代表活动图纸空间布局的所有对象。如果不同的图纸空间的布局被设为活动的，PaperSpace 将会改变以反映新的活动图纸空间的数据。这三个接口具有很多相同的方法。下面介绍的方法就是三个接口所共有的。

主要方法：

  • InsertBlock(InsertionPoint As Double, BlockName As String, [XScale As Double = 1], [YScale As Double = 1], [ZScale As Double = 1], [Rotation As Double]) As ZcadBlockInsert 该方法用来插入图形文件或者已经命名的块。InsertionPoint 参数是块插入的位置。BlockName 参数是要插入的块名，Xscale、Yscale、Zscale 参数为插入块的比例，默认情况下为 1.Rotation 参数为插入的旋转角度。
  • Item(Index As Long) as Ojbect 该方法用指定的索引来获得成员对象。Item 参数为将要查询的对象成员的索引，返回值为在给定索引位置的对象。
  • AddLine(StartPoint As Double, EndPoint As Double) As ZcadLine 该方法通过传入两个 Double 类型的数组来建立一条线。StartPoint 参数为线的起点，EndPoint 参数为线的终点，返回值为新创建的线对象。

主要属性：

  • Count 代表集合中实体个数。

ZcadCircle、ZcadLine、ZcadPolyLine 接口

这三个接口分别代表圆、线和多段线对象，它们具有很多相同的方法。下面介绍的方法和属性就是它们所共有的。

主要方法：

  • Update（）当圆、线等实体修改后，Update 会更新这些实体。
  • Move（Point1 as Double,Point2 as Double） 该方法使对象沿着向量方向移动。参数 Point1 指定移动向量的第一个点，参数 Point2 指定移动向量的第二个点。

主要属性：

  • Color 属性主要用来指定对象的颜色。
  • Visible 属性主要用来指定对象是否可见。


创建ZWCAD对象

创建中望CAD 对象

在中望CAD 中用户可以通过接口来创建各种类型的对象，从最基本的单行文字、直线到复杂的三维实体、样条曲线、填充等。用户一般都是通过Add方法中的一种向模型空间、图纸空间或者块中创建对象。

虽然在中望CAD 中有多种方法来创建同一个对象，但是在中望CAD VBA中只提供了一个方法。例如，在中望CAD 中创建圆有四种不同方法：

  • 通过指定圆心和半径
  • 通过定义直径的两点
  • 通过定义圆周的三点
  • 通过两个切点和一个半径

但是 ActiveX Automation 只提供了一种创建圆的方法使用圆心和半径。创建对象后，可以通过对象的属性来修改其特性值，或者是通过对象的方法来对其进行某些操作，下一章将重点介绍如何使用对象常用方法来编辑对象。

本节包含如下内容：

  • 创建点对象
  • 创建直线和多段线
  • 创建曲线
  • 创建单行文字和多行文字
  • 创建标注和公差
  • 创建选择集
  • 创建面域
  • 创建图层和颜色


创建点对象

Point是一个实体作为捕捉或者移动的参考点，系统变量PDMODE和PDSIZE可以控制Point对象的外观，具体详见中望CAD 帮助文档。

Point 对象

在模型空间中创建 Point 对象。

Sub Example_AddPointEntity()
    'Create a  pointEntity in the modelspace
    Dim pointObj As ZcadPoint
    Dim location(0 To 2) As Double
    location(0) = 100#: location(1) = 200#: location(2) = 0#
    Set pointObj =ThisDrawing.ModelSpace.AddPoint (location)
    ThisDrawing.Regen zcActiveViewport

End Sub


创建直线和多段线

直线、多段线都是中望CAD 中基本的对象。用户可以通过指定的坐标点来在 ModelSpace、PaperSpace 集合或者 Block 对象中增加直线、多段线。如下示例是使用 AddLine 和 AddLightweightPolyine 方法来创建直线和多段线。

创建直线

创建起点坐标是（2，9），终点坐标是（50，60）的直线。

Sub Example_AddLine()
    'This example adds a line in model space

    Dim lineObj As ZcadLine
    Dim startPoint(0 To 2) As Double
    Dim endPoint(0 To 2) As Double

    'Define the start and end points for the line
    startPoint(0) = 2#: startPoint(1) = 9#: startPoint(2) = 0#
    endPoint(0) = 50#: endPoint(1) = 60#: endPoint(2) = 0#

    'Create the line in model space
    Set lineObj =ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    lineObj.Update
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

创建多段线

创建端点坐标是（2，3）、（8，20）、（10，25）、（20，27）、（30、40）的多段线并修改其颜色为红色。

Sub Example_AddLightWeightPolyline()
    'This example creates a lightweight polyline in model space.

    Dim plineObj As ZcadLWPolyline
    Dim Points(0 To 9) As Double
    Points(0) = 2: Points(1) = 3
    Points(2) = 8: Points(3) = 20
    Points(4) = 10: Points(5) = 25
    Points(6) = 20: Points(7) = 27
    Points(8) = 30: Points(9) = 40

    'Create a lightweight Polyline object in model space
    Set plineObj =ThisDrawing.ModelSpace.AddLightWeightPolyline(Points)
    plineObj.Color = zcRed
    plineObj.Update
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub


创建曲线

圆、圆弧、样条曲线、椭圆都是中望CAD 中基本的曲线对象。用户可以在 ModelSpace、PaperSpace 集合或者 Block 对象来创建。如下示例是用 AddArc、AddCircle、AddEllipse、AddSpline方法分别创建圆弧、圆、椭圆、样条曲线对象。

创建圆弧

在模型空间创建圆心是（0，0，0），半径为5，起始角度分别是 30、270 度圆弧。

Sub Example_AddArc()
    ' This example creates an arc in model space.
    Dim arcObj As ZcadArc
    Dim centerPoint(0 To 2) As Double
    Dim radius As Double
    Dim startAngleInDegree As Double
    Dim endAngleInDegree As Double

    ' Define the circle
    centerPoint(0) = 0#: centerPoint(1) = 0#: centerPoint(2) = 0#
    radius = 5#
    startAngleInDegree = 30#
    endAngleInDegree = 270#

    ' Convert the angles in degrees to angles in radians
    Dim startAngleInRadian As Double
    Dim endAngleInRadian As Double
    startAngleInRadian = startAngleInDegree * 3.141592 / 180#
    endAngleInRadian = endAngleInDegree * 3.141592 / 180#

    ' Create the arc object in model space
    Set arcObj = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll
End Sub

创建圆

在模型空间创建圆心为（10，10，0），半径为10的圆。

Sub Example_AddCircle()
    ' This example creates a circle in model space.
    Dim circleObj As ZcadCircle
    Dim centerPoint(0 To 2) As Double
    Dim radius As Double

    ' Define the circle
    centerPoint(0) = 10#: centerPoint(1) = 10#: centerPoint(2) = 0#
    radius = 10#

    ' Create the Circle object in model space
    Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

创建椭圆

在模型空间创建中心点是（10，10，0），长轴向量是（15，20，0），定义椭圆长轴与短轴比率是 0.75 的椭圆。

Sub Example_AddEllipse()
    ' This example creates an ellipse in model space
    Dim ellObj As ZcadEllipse
    Dim majAxis (0 To 2) As Double
    Dim center (0 To 2) As Double

    Dim radRatio As Double

    ' Create an ellipse in model space
    center(0) = 10#: center(1) = 10#: center(2) = 0#
    majAxis(0) = 15: majAxis(1)= 20#: majAxis(2)= 0#
    radRatio = 0.75
    Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)
    ellObj.Update
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

创建样条曲线

在模型空间创建拟合点坐标分别是（1，1，0）、（5，5，0）、（10，0，0），起点相切的三维向量（0.5，0.5，0），终点相切的三维向量（0.5，0.5，0）样条曲线。

Sub Example_AddSpline()
    ' This example creates a spline object in model space.
    Dim splineObj As ZcadSpline
    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)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll
End Sub


创建单行文字和多行文字

文字表达了图形中重要信息，中望CAD 中文字可以分为单行文字和多行文字。如下示例用AddText和AddMText分别来创建单行文字和多行文字，并且修改单行文字和多行文字的一些属性值。

创建单行文字

在模型空间中坐标是（100，100,0）的位置创建单行文字，并修改其高度、颜色、倾斜度、生成标志。

Sub Example_AddText()
    ' This example creates a text object in model space

    Dim textObj As ZcadText
    Dim textString As String
    Dim insertionPoint (0 To 2) As Double
    Dim height As Double

    ' Define the text object
    textString = "ABCD"
    insertionPoint(0) = 100: insertionPoint(1) = 100: insertionPoint(2) = 0
    height = 10

    ' Create the text object in model space
    Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
    textObj.Color = zcBlue
    textObj.ObliqueAngle = (45 / 180) * 3.1415926
    textObj.height = 20
    textObj.TextGenerationFlag = zcTextFlagBackward + zcTextFlagUpsideDown
    textObj.Update
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

创建多行文字

在模型空间中坐标时（100，100，0）的位置处创建多行文字对象。

Sub Example_AddMtext()
    ' This example creates a MText object in model space

    Dim MTextObj As ZcadMText
    Dim corner (0 To 2) As Double
    Dim width As Double
    Dim text As String
    corner(0) = 100#: corner(1) = 100#: corner(2) = 0#
    width = 20
    text = "This is the text String for the mtext Object"

    ' Creates the mtext Object
    Set MTextObj = ThisDrawing.ModelSpace.AddMText(corner, width, text)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub


创建标注和公差

标注有六种基本类型：线性标注、角度标注、半径标注、直径标注、坐标标注和引线标注。可以为指定的实体创建标注，也可以创建独立的标注。例如,可以为一个实体创建线性标注，也可以通过在图形上指定两个尺寸界线起点来创建标注。标注系统变量可以控制标注的外观。标注系统变量有如下：DIMAUNIT、DIMUPT、DIMTOFL、DIMFIT、DIMTIH、DIMTOH、DIMJUST 和 DIMTAD。可以使用方法SetVariable来设置这些变量。

创建线性标注

中望CAD VBA中提供了8种方法创建标注，我们按照标注的类型介绍其中的几种。线型标注可以分为对齐标注和转角标注，要创建线性标注可以用AddDimAligned或者AddDimRotated方法。

Sub Example_AddDimAligned()
    ' This example creates a DimAligned object in model space.
    Dim dimObj As ZcadDimAligned
    Dim point1(0 To 2) As Double
    Dim point2(0 To 2) As Double
    Dim location(0 To 2) As Double

    ' Define the dimension
    point1(0) = 5#: point1(1) = 5#: point1(2) = 0#
    point2(0) = 20#: point2(1) = 5#: point2(2) = 0#
    location(0) = 5#: location(1) = 7#: location(2) = 0#

    'Create a DimAligned object in model space
    Set dimObj = ThisDrawing.ModelSpace.AddDimAligned(point1, point2, location)
    dimObj.TextColor = zcBlue        'Change the text's color
    dimObj.TextOverride = "长度是<>" 'Add comment
    dimObj.Update
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

创建直径标注

半径标注和直径标注分别用于测量圆弧和圆的半径与直径，要创建半径标注和直径标注可以分别用AddDimRadial方法，AddDiametric方法。

Sub Example_AddDimDiametric()
    ' This example creates a diametric dimension in model space

    Dim dimObj As ZcadDimDiametric
    Dim chordPoint (0 To 2) As Double
    Dim farChordPoint (0 To 2) As Double
    Dim leaderLength As Double

    ' Define the dimension
    chordPoint(0) = 5#: chordPoint(1) = 3#: chordPoint(2) = 0#
    farChordPoint(0) = 15#: farChordPoint(1) = 13#: farChordPoint(2) = 0#
    leaderLength = 1#

    ' Create the diametric dimension in model space
    Set dimObj = ThisDrawing.ModelSpace.AddDimDiametric(chordPoint, farChordPoint, leaderLength)
    dimObj.Update
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

创建三点角度标注

角度标注可以测量两条线或三个点之间的角度。创建角度标注可以使用AddDimAngular，AddDim3PointAngular方法。

Sub Example_AddDim3PointAngular()
    ' This example creates a Dim3PointAngular in model space

    Dim DimPointAngularObj As ZcadDim3PointAngular
    Dim AngleVertex (0 To 2) As Double
    Dim FirstPoint (0 To 2) As Double, SecondPoint (0 To 2) As Double
    Dim TextPoint (0 To 2) As Double

    ' Define the new Dim3PointAngular object
    AngleVertex(0) = 1: AngleVertex(1) =1: AngleVertex(2) = 0
    FirstPoint(0) = 3: FirstPoint(1) = 3: FirstPoint(2) = 0
    SecondPoint(0) = 5: SecondPoint(1) = 4: SecondPoint(2) = 0
    TextPoint(0) = 10: TextPoint(1) = 10: TextPoint(2) = 0

    ' Create the new Dim3PointAngular object in model space
    Set DimPointAngularObj = ThisDrawing.ModelSpace.AddDim3PointAngular(AngleVertex, FirstPoint, SecondPoint, TextPoint)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

创建坐标标注

坐标标注可以测量点到原点的X坐标和Y坐标的值。可以使用AddDimOrdinate方法创建坐标标注，该方法中有一个布尔参数用来控制创建的是X基准坐标标注，还是Y基准坐标标注。

Sub Example_AddDimOrdinate()
    ' This example creates an ordinate dimension in model space.

    Dim dimObj As ZcadDimOrdinate
    Dim definingPoint(0 To 2) As Double
    Dim leaderEndPoint (0 To 2) As Double
    Dim useXAxis As Boolean

    ' Define the dimension
    definingPoint(0) = 2: definingPoint(1) = 6#: definingPoint(2) = 0#
    leaderEndPoint(0) = 20#: leaderEndPoint(1) = 20#: leaderEndPoint(2) = 0#
    useXAxis = True

    ' Create an ordinate dimension in model space
    Set dimObj = ThisDrawing.ModelSpace.AddDimOrdinate(definingPoint, leaderEndPoint, useXAxis)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

创建引线标注

引线标注就是引线加上注解（多行文字、块、公差）的直线或者样条曲线，要创建引线可以用AddLeader方法。该方法有三个参数分别是控制引线位置的，引线是否有注解，引线标注的类型。

Sub Example_AddLeader()
    ' This example creates a Leader dimension in model space.

    Dim MTextObj As ZcadMText
    Dim insertionPoint (0 To 2) As Double
    Dim width As Double
    Dim textString As String
    textString = "Test"
    insertionPoint(0) = 25: insertionPoint(1) = 35: insertionPoint(2) = 0
    width = 10
    Set MTextObj = ThisDrawing.ModelSpace.AddMText(insertionPoint, width, textString)

    ' Define the dimension
    Dim leaderObj As ZcadLeader
    Dim leaderType As Integer
    Dim points (0 To 8) As Double
    Dim annotationObject As Object

    'Create a Leader dimension in model space
    Points(0) = 1: Points(1) = 1: Points(2) = 0
    Points(3) = 6: Points(4) = 6: Points(5) = 0
    Points(6) = 20: Points(7) = 30: Points(8) = 0
    leaderType = zcLineWithArrow
    Set annotationObject = MTextObj
    Set leaderObj = ThisDrawing.ModelSpace.AddLeader(points, annotationObject, leaderType)
    ThisDrawing.Regen zcActiveViewport

End Sub

在图形中添加形位公差，以表示特征的形状、轮廓、方向、位置和跳动的允许偏差。可以通过AddTolerance方法来创建形位公差，该方法需要输入三个参数分别是：公差符号的字符串，插入点以及方向矢量，公差受以下系统变量的影响：DIMCLRD、DIMCLRT、DIMGAP、DIMTXT、DIMTXTSTY，系统变量的具体用法可以参考中望CAD 的帮助文档。

创建公差

Sub Example_AddTolerance()
    ' This example creates a tolerance object in model space.

    Dim toleranceObj As ZcadTolerance
    Dim textString As String
    Dim insertionPoint(0 To 2) As Double
    Dim direction (0 To 2) As Double

     ' Define the tolerance object
    textString = "Here is the Test"
    insertionPoint(0) = 15#: insertionPoint(1) = 5#: insertionPoint(2) = 0#
    direction(0)= 1#: direction(1)= 1#: direction(2)= 0#

     ' Create the tolerance object in model space
    Set toleranceObj = ThisDrawing.ModelSpace.AddTolerance(textString, insertionPoint, direction)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub


创建选择集

选择集是单一处理的一个或者多个中望CAD 对象的组合。要创建选择集可以使用 Add 方法。此方法仅需要一个选择集名称作为参数。创建选择集后，可以使用 AddItems、SelectAtPoint、SelectByPolygon、SelectOnScreen 中任意一个方法向其中添加对象。创建一个新的选择集，通过 AddItems 方法把创建的图元添加到该选择集中。

创建选择集

创建一个名为 TEST 的选择集，并向选择集中添加实体。

Sub Example_AddItems()

    ' Create the new selection set
    Dim ssetObj As ZcadSelectionSet
    Set ssetObj =ThisDrawing.SelectionSets.Add("TEST")

    ' Create a line object in model space
    Dim lineObj As ZcadLine
    Dim startPoint (0 To 2) As Double
    Dim endPoint(0 To 2) As Double
    startPoint(0) = 20: startPoint(1) = 18: startPoint(2) = 0
    endPoint(0) = 100: endPoint(1) = 102: endPoint(2) = 0
    Set lineObj =ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)

    ' Create a circle object in model space
    Dim circObj As ZcadCircle
    Dim centerPt (0 To 2) As Double
    Dim radius As Double
    centerPt(0) = 0: centerPt(1) =0: centerPt(2) = 0
    radius = 100
    Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)

    ' Create an ellipse object in model space
    Dim ellObj As ZcadEllipse
    Dim majAxis (0 To 2) As Double
    Dim center (0 To 2) As Double
    Dim radRatio As Double
    center(0) = 5#: center(1) = 5#: center(2) = 0#
    majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0#
    radRatio = 0.75
    Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)

    ReDim ssobjs(0 To ThisDrawing.ModelSpace.Count - 1) As ZcadEntity
    Dim I As Integer
    For I = 0 To ThisDrawing.ModelSpace.Count - 1
        Set ssobjs(I) =ThisDrawing.ModelSpace.Item(I)
    Next

    ' Add the array of objects to the selection set
    ssetObj.AddItems ssobjs
    ThisDrawing.Regen zcActiveViewport
    MsgBox ssetObj.Count

End Sub

用户使用SelectAtPoint、SelectByPolygon、SelectOnScreen中任意方法时可以指定具体的过滤器列表来限制选择集中实体的种类。过滤器类型DXF组码的具体含义参考中望CAD 帮助文档中的“DXF参考”。创建一个新的选择集，提示用户添加到选择集的对象是“圆”和“直线”。

Sub Example_SelectOnScreen()

    ' Create the new selection set
    Dim ssetObj As ZcadSelectionSet
    Set ssetObj =ThisDrawing.SelectionSets.Add("TEST")
    Dim FilterType(3) As Integer
    Dim FilterData(3) As Variant
    ' Create a line object in model space
    Dim lineObj As ZcadLine
    Dim startPoint (0 To 2) As Double
    Dim endPoint (0 To 2) As Double
    startPoint(0) = 20: startPoint(1) = 18: startPoint(2) = 0
    endPoint(0) = 100: endPoint(1) = 102: endPoint(2) = 0
    Set lineObj =ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)

    ' Create a circle object in model space
    Dim circObj As ZcadCircle
    Dim centerPt (0 To 2) As Double
    Dim radius As Double
    centerPt(0) = 0: centerPt(1) = 0: centerPt(2) = 0
    radius = 100
    Set circObj =ThisDrawing.ModelSpace.AddCircle(centerPt, radius)

    ' Create an ellipse object in model space
    Dim ellObj As ZcadEllipse
    Dim majAxis (0 To 2) As Double
    Dim center (0 To 2) As Double
    Dim radRatio As Double
    center(0) = 5#: center(1) = 5#: center(2) = 0#
    majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0#
    radRatio = 0.75
    Set ellObj =ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

    FilterType(0) = -4
    FilterData(0) = "<or"
    FilterType(1) = 0
    FilterData(1) = "Circle"
    FilterType(2) = 0
    FilterData(2) = "Line"
    FilterType(3) = -4
    FilterData(3) = "or>"

    ssetObj.SelectOnScreen FilterType, FilterData
    MsgBox "选择集中实体的名称是：" & vbCrLf & ssetObj.Item(0).EntityName & vbCrLf & ssetObj.Item(1).EntityName
    MsgBox "选择集中的个数是：" & ssetObj.Count
    ssetObj.Delete

End Sub

编辑选择集

创建选择集之后，用户可以通过RemoveItems，Clear、Erase、Delete中的方法来删除选择集或者选择集中的项。通过RemoveItems方法来删除选择集中指定的对象。

Sub Example_RemoveItems()

    ' Create the new selection set
    Dim ssetObj As ZcadSelectionSet
    Set ssetObj =ThisDrawing.SelectionSets.Add("TEST")

    ' Create a line object in model space
    Dim lineObj As ZcadLine
    Dim startPoint (0 To 2) As Double
    Dim endPoint (0 To 2) As Double
    startPoint(0) = 20: startPoint(1) = 18: startPoint(2) = 0
    endPoint(0) = 100: endPoint(1) = 102: endPoint(2) = 0
    Set lineObj =ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)

    ' Create a circle object in model space
    Dim circObj As ZcadCircle
    Dim centerPt (0 To 2) As Double
    Dim radius As Double
    centerPt(0) = 0: centerPt(1) = 0: centerPt(2) = 0
    radius = 100
    Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)

    ' Create an ellipse object in model space
    Dim ellObj As ZcadEllipse
    Dim majAxis (0 To 2) As Double
    Dim center (0 To 2) As Double
    Dim radRatio As Double
    center(0) = 5#: center(1) = 5#: center(2) = 0#
    majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0#
    radRatio = 0.75
    Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)

    ReDim ssobjs(0 To ThisDrawing.ModelSpace.Count - 1) As ZcadEntity
    Dim I As Integer
    For I = 0 To ThisDrawing.ModelSpace.Count - 1
        Set ssobjs(I) =ThisDrawing.ModelSpace.Item(I)
    Next

    ' Add the array of objects to the selection set
    ssetObj.AddItems ssobjs
    ThisDrawing.Regen zcActiveViewport
    MsgBox ssetObj.Count
    Dim rents(0 To 1) As ZcadEntity
    Set rents(0) = ssetObj.Item(0)
    Set rents(1) = ssetObj.Item(1)
    ssetObj.RemoveItems rents
    ssetObj.Update
    MsgBox ssetObj.Count

End Sub


创建面域

面域是一个二维区域。要转化为面域的对象必须是闭合的对象。例如闭合多段线、直线和曲线（圆弧、圆、椭圆弧、椭圆和样条曲线），所有相交或自交的曲线不可被转化为面域。

创建面域

在模型空间中创建一个面域。

Sub Example_AddRegion()
    ' This example creates a region from an arc and a line
    Dim curves(0 To 1) As ZcadEntity
    Dim arcObj As ZcadArc

    ' Define the arc
    Dim centerPoint (0 To 2) As Double
    Dim radius As Double
    Dim startAngle As Double
    Dim endAngle As Double
    centerPoint(0) = 100#: centerPoint(1) = 100#: centerPoint(2) = 0#
    radius = 10#
    startAngle = 0
    endAngle = 3.141592
    Set curves(0) =ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngle, endAngle)

    Set arcObj = curves(0)
    ' Define the line
    Dim p1 As Variant
    Dim p2 As Variant
    p1 = arcObj.startPoint
    p2 = arcObj.endPoint
    Set curves(1) =ThisDrawing.ModelSpace.AddLine(p1, p2)

    ' Create the region
    Dim regionObj As Variant
    regionObj =ThisDrawing.ModelSpace.AddRegion(curves)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub


创建图层和颜色

在中望CAD 中，图层就像是用户徒手绘制草稿的透明图纸。可以使用图层来组织不同形式的图形信息。每个对象都是存在一个图层上，当用户绘制对象时，该对象建立在当前的图层上。

图层的各种属性方便对图层的操作，常用属性如下：

  • 图层是否为活动图层
  • 打开或者关闭图层
  • 冻结或者解冻图层
  • 锁定或者解锁图层
  • 图层的颜色
  • 图层的线型

创建图层

在文档中创建新图层，并修改其各种属性。

Sub Example_layer()

    Dim layerObj1 As ZcadLayer
    Dim layerObj2 As ZcadLayer
    Dim layerObj3 As ZcadLayer
    Dim templayer As ZcadLayer
    Dim msg As String
    Set layerObj1 =ThisDrawing.Layers.Add("test1")
    Set layerObj2 =ThisDrawing.Layers.Add("test2")
    Set layerObj3 =ThisDrawing.Layers.Add("test3")

    For Each templayer In ThisDrawing.Layers
        msg = msg + templayer.Name + vbCrLf
    Next

    MsgBox "The layers in this Document are: " & vbCrLf & msg

    ThisDrawing.ActiveLayer = layerObj1
    layerObj1.Color = zcRed
    ThisDrawing.Linetypes.Load "CENTER", "Zwcad.lin"
    ThisDrawing.ActiveLinetype =ThisDrawing.Linetypes("CENTER")
    layerObj2.Linetype = "CENTER"
    layerObj3.LineWeight = zcLnWt211

    Dim circleobj As ZcadCircle
    Dim center(0 To 2) As Double
    Dim r As Double
    r = 100#
    center(0) = 100: center(1) = 100: center(2) = 0
    Set circleobj =ThisDrawing.ModelSpace.AddCircle(center, r)
    ThisDrawing.Regen zcActiveViewport
    circleobj.Layer = "test3"
    circleobj.Color = zcBlue
    circleobj.Update
    layerObj1.LayerOn = False
    layerObj2.Freeze = True
    layerObj3.Lock = True

    If layerObj1.LayerOn Then
        MsgBox "Layer " & layerObj1.Name & " is turned on.", , "Freeze Example"
    Else
        MsgBox "Layer " & layerObj1.Name & " is turned off.", , "Freeze Example"
    End If

    If layerObj2.Freeze Then
        MsgBox "Layer " & layerObj2.Name & " is frozen.", , "Freeze Example"
    Else
        MsgBox "Layer " & layerObj2.Name & " is thawed.", , "Freeze Example"
    End If

    If layerObj3.Lock Then
        MsgBox "Layer " & layerObj3.Name & " is locked.", , "Lock Example"
    Else
        MsgBox "Layer " & layerObj3.Name & " is unlocked.", , "Lock Example"
    End If

    MsgBox "The layer" & " " & layerObj2.Name & " of Linetype is " & layerObj2.Linetype, , "Linetype Example"

    MsgBox "The layer" & " " & layerObj3.Name & " of LineWeight is " & layerObj3.LineWeight, , "LineWeight Example"

End Sub

定义颜色

对象的颜色设置有以下三种方式，索引颜色的取值为 1 - 255 、bylayer 、byblock 以及各个颜色值（例如 RED、BLUE 等）。如果输入 byblock，系统将以默认的白色或黑色来绘制所有新对象。如果输入 bylayer，则新对象采用创建该对象时所在图层的指定颜色。输入三个用逗号隔开的 0 至 255 之间的整数值来指定真彩色，具体详见 SetRGB 方法。从加载的配色系统中指定对象的颜色，具体详见 SetColorBookColor 方法。


编辑ZWCAD对象

编辑中望CAD 对象

创建图元后，可以使用该对象的方法和属性来修改对象。修改对象后需要用Update方法来更新显示。

本章内容包括：

  • 重命名和复制对象
  • 偏移和移动对象
  • 镜像、缩放和旋转对象
  • 阵列和变换对象
  • 删除和分解对象
  • 延伸对象
  • 编辑多段线和样条曲线


重命名和复制对象

创建对象后可以重命名对象，但是中望CAD 默认的对象除外。例如，图层0 等。在重命名时要注意事项：名称最长可以包含255个字符。除了字母和数字之外，名称中还可以包含空格（虽然中望CAD 会删除名称前后的空格）以及 Microsoft Windows 或 中望CAD 未用作其他用途的任何特殊字符。不能使用的特殊字符包括小于号和大于号 (< >)、正斜杠和反斜杠 (/ \)、引号 (")、冒号 (:)、分号 (;)、问号 (?)、逗号 (,) 星号 (*)、竖线 (|)、等号 (=) 和单引号 (')。也不能使用以 Unicode 字体创建的特殊字符。

重命名块

使用Rename方法为新创建的块修改名称。

Sub Example_Rename()

    Dim blockObj As ZcadBlock
    Dim insertionPnt (0 To 2) As Double
    insertionPnt(0)= 0#: insertionPnt(1)= 0#: insertionPnt(2)= 0#
    Set blockObj =ThisDrawing.Blocks.Add(insertionPnt, "Testblock")
    blockObj.Name = "Test"

End Sub

复制对象

用户可以在当前图形中复制一个或多个对象，如果复制单个对象可以使用Copy方法。此方法可以创建一个与原始对象完全一样的对象并且位置相同。如果复制多个对象，可以使用CopyObjects方法。

Sub Example_CopyObjects()

    Dim DOC1 As ZcadDocument, DOC2 As ZcadDocument
    Dim circleObj1 As ZcadCircle, circleObj2 As ZcadCircle
    Dim circleObj1Copy As ZcadCircle, circleObj2Copy As ZcadCircle
    Dim centerPoint (0 To 2) As Double
    Dim radius1 As Double, radius2 As Double
    Dim radius1Copy As Double, radius2Copy As Double
    Dim objCollection(0 To 1) As ZcadEntity
    Dim objselect As ZcadSelectionSet
    Dim Mspace As ZcadModelSpace
    Dim retObjects As Variant

    ' Define the Circle object
    centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0
    radius1 = 10#: radius2 = 70#
    radius1Copy = 100#: radius2Copy = 200#

    ' Create a new document
    Set DOC1 =ThisDrawing.Application.Documents.Add
    Set DOC2 =ThisDrawing.Application.Documents.Item(0)

    Set Mspace = DOC2.ModelSpace
    ' Add two circles to the document
    Set circleObj1 = DOC1.ModelSpace.AddCircle(centerPoint, radius1)
    Set circleObj2 = DOC1.ModelSpace.AddCircle(centerPoint, radius2)
    ThisDrawing.Application.ZoomAll

    Set objCollection(0) = circleObj1
    Set objCollection(1) = circleObj2
    Set objselect =ThisDrawing.SelectionSets.Add("TEST")
    objselect.AddItems objCollection
    retObjects = DOC1.CopyObjects(objCollection, Mspace)

    ' Get newly created object and apply new properties to the copies
    Set circleObj1Copy = retObjects(0)
    Set circleObj2Copy = retObjects(1)
    circleObj1Copy.radius = radius1Copy
    circleObj2Copy.radius = radius2Copy
    ThisDrawing.Application.ZoomAll
    MsgBox "Circles copied."

End Sub


偏移和移动对象

偏移对象可以在距原始对象的指定偏移距离处创建新的对象。使用Offset方法可以偏移直线、多段线、圆弧、圆等对象。

偏移对象

创建一个 Polyline，使用 Offset 方法偏移该多段线。

Sub Example_OffsetPolyline()

    ' Create the polyline
    Dim plineObj As ZcadLWPolyline
    Dim points(0 To 5) As Double
    points(0) = 1: points(1) = 1
    points(2) = 1: points(3) = 2
    points(4) = 2: points(5) = 2

    Set plineObj =ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
    plineObj.Closed = True
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

    ' Offset the polyline
    Dim offsetObj As Variant
    Set offsetObj =ThisDrawing.SelectionSets.Add("test")
    offsetObj = plineObj.Offset(0.25)

End Sub

用户可以沿矢量移动对象而不改变对象的方向或大小，还可以绕基点旋转对象。

移动对象

创建一个圆弧，使用 move 方法移动该圆弧。

Sub Example_Move()

    ' Create the arc
    Dim arcObj As ZcadArc
    Dim centerPoint (0 To 2) As Double
    Dim radius As Double
    Dim startAngleInDegree As Double, endAngleInDegree As Double
    Dim startAngleInRadian As Double, endAngleInRadian As Double

    ' Define the Arc
    centerPoint(0) = 2#: centerPoint(1) = 2#: centerPoint(2) = 0#
    radius = 5#
    startAngleInDegree = 10#: endAngleInDegree = 230#

    ' Convert the angles in degrees to angles in radians
    startAngleInRadian = startAngleInDegree * 3.141592 / 180#
    endAngleInRadian = endAngleInDegree * 3.141592 / 180#
    Set arcObj = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
    ThisDrawing.Application.ZoomAll

    ' Define the points that make up the move vector
    Dim point1 (0 To 2) As Double
    Dim point2 (0 To 2) As Double
    point1(0) = 0: point1(1) = 0: point1(2) = 0
    point2(0) = 2: point2(1) = 0: point2(2) = 0
    MsgBox "Move the arc 2 units in the X direction.", , "Move Example"

    ' Move the arc
    arcObj.Move point1, point2
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll
    MsgBox "Move completed.", , "Move Example"

End Sub


镜像、缩放和旋转对象

以一条线或一个平面为基础创建对象的反射副本，也就是镜像图像。要镜像对象使用该对象的 Mirror 方法。

镜像对象

创建一条直线，镜像该直线。新创建的直线会着上蓝色。

Sub Example_Mirror()

    Dim lineObj As ZcadLine
    Dim startPoint (0 To 2) As Double
    Dim endPoint (0 To 2) As Double

    ' Define the start and end points for the line
    startPoint(0) = 50#: startPoint(1) = 50#: startPoint(2) = 0#
    endPoint(0) = 100#: endPoint(1) = 100#: endPoint(2) = 0#

    ' Create the line in model space
    Set lineObj =ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    ThisDrawing.Regen zcActiveViewport
    Dim point1 (0 To 2) As Double
    Dim point2 (0 To 2) As Double
    point1(0) = 120
    point1(1)= 120
    point1(2) = 0
    point2(0) = 120
    point2(1) = 10
    point2(2) = 0
    Dim mirrorObj As ZcadLine
    Set mirrorObj = lineObj.Mirror(point1, point2)
    mirrorObj.Color = zcBlue
    mirrorObj.Update
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll
    MsgBox "Mirror completed.", , "Mirror Example"

End Sub

用户可以通过指定的基点和缩放比例来缩放对象。要缩放对象使用该对象的 ScaleEntity 方法。

缩放对象

创建一个圆弧，然后以 0.5 的缩放比例调整该圆弧。

Sub Example_ScaleEntity()
    ' This example creates an arc
    ' and then scales that arc.

    ' Create the arc
    Dim arcObj As ZcadArc
    Dim centerPoint (0 To 2) As Double
    Dim radius As Double
    Dim startAngleInDegree As Double, endAngleInDegree As Double
    Dim startAngleInRadian As Double, endAngleInRadian As Double

    ' Define the Arc
    centerPoint(0) = 2#: centerPoint(1) = 2#: centerPoint(2) = 0#
    radius = 5#
    startAngleInDegree = 10#: endAngleInDegree = 230#

    ' Convert the angles in degrees to angles in radians
    startAngleInRadian = startAngleInDegree * 3.141592 / 180#
    endAngleInRadian = endAngleInDegree * 3.141592 / 180#

    Set arcObj =ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
    ThisDrawing.Regen zcActiveViewport

    MsgBox "Scale the arc by 0.5", , "ScaleEntity Example"

    ' Define the scale
    Dim basePoint (0 To 2) As Double
    Dim scalefactor As Double
    basePoint(0) = 2: basePoint(1) = 2: basePoint(2) = 0
    scalefactor = 0.5

    ' Scale the arc
    arcObj.ScaleEntity basePoint, scalefactor
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll
    MsgBox "Scale completed.", , "ScaleEntity Example"

End Sub

用户可以通过指定的基点和角度（以弧度表示）来旋转对象，要旋转对象使用 Rotate 方法。

旋转对象

创建一条多段线，然后将该多段线绕基点（100，100，0）旋转180度。

Sub Example_Rotate()
    ' This example creates a Polyline
    ' and then rotate that Polyline.

    ' Create the Polyline
    Dim plineObj As ZcadLWPolyline
    Dim Points (0 To 5) As Double

    points(0) = 2: points(1) = 3
    points(2) = 8: points(3) = 20
    points(4) = 100: points(5) = 100

    Set plineObj =ThisDrawing.ModelSpace.AddLightWeightPolyline(Points)
    ThisDrawing.Regen zcActiveViewport

    ' Define the rotation
    Dim basePoint (0 To 2) As Double
    Dim rotationAngle As Double
    basePoint(0) = 100: basePoint(1) = 100: basePoint(2) = 0
    rotationAngle = 3.1415926

    plineObj.Rotate basePoint, rotationAngle
    plineObj.Color = zcRed
    plineObj.Update
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll
    MsgBox "Rotation completed.", , "Rotate Example"

End Sub


阵列和变换对象

阵列就是创建对象的副本，使副本按照矩形或者环形阵列排列。矩形阵列，可控制行和列的数目以及它们之间的距离。环形阵列，可以控制对象副本的数目并决定是否旋转副本。

阵列对象

要创建环形阵列，可以使用 ArrayPolar 方法，这个方法有四个参数分别是：创建的对象数目、填充角度、阵列中心点、是否旋转。创建 3DFace 对象，然后以点（50，50）为中心点，填充角度是 180 度，阵列数目是 4，阵列过程中选择对象。

Sub Example_ArrayPolar()
    ' This example creates a 3DFACE and then performs a polar array
    ' on that 3DFACE.

    ' Create the 3DFACE
    Dim faceObj As Zcad3DFace
    Dim point1 (0 To 2) As Double
    Dim point2 (0 To 2) As Double
    Dim point3 (0 To 2) As Double
    Dim point4 (0 To 2) As Double

    ' Define the four coordinates of the face
    point1(0) = 1#: point1(1) = 1#: point1(2) = 0#
    point2(0) = 5#: point2(1) = 1#: point2(2) = 1#
    point3(0) = 1#: point3(1) = 10#: point3(2) = 0#
    point4(0) = 5#: point4(1) = 5#: point4(2) = 1#

    ' Create the 3DFace object in model space
    Set faceObj =ThisDrawing.ModelSpace.Add3DFace(point1, point2, point3, point4)
    faceObj.Update
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll
    MsgBox "Perform the polar array on the 3DFace.", , "ArrayPolar Example"

    ' Define the polar array
    Dim noOfObjects As Integer
    Dim angleToFill As Double
    Dim basePnt (0 To 2) As Double
    noOfObjects = 4
    angleToFill = 3.14          ' 180 degrees
    basePnt(0) = 50#: basePnt(1) = 50#: basePnt(2) = 0#

    ' The following example will create 4 copies of an object
    ' by rotating and copying it about the point (50,50,0)
    Dim retObj As Variant
    Set retObj =ThisDrawing.SelectionSets.Add("New set")
    retObj = faceObj.ArrayPolar(noOfObjects, angleToFill, basePnt)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll
    MsgBox "Polar array completed.", , "ArrayPolar Example"

 End Sub

要创建二维或三维的矩形阵列，可以使用 ArrayRectangular 方法。需要输入六个参数：行数、列数、层数、行间距、列间距、层间距。以 5 行、5 列、2 层，行间距和列间距是 10、层间距是 1，来创建三维矩形阵列。

Sub Example_ArrayRectangular()

    ' Create the 3DFACE
    Dim faceObj As Zcad3DFace
    Dim point1(0 To 2) As Double
    Dim point2 (0 To 2) As Double
    Dim point3 (0 To 2) As Double
    Dim point4 (0 To 2) As Double

    ' Define the four coordinates of the face
    point1(0) = 1#: point1(1) = 1#: point1(2) = 0#
    point2(0) = 5#: point2(1) = 1#: point2(2) = 1#
    point3(0) = 1#: point3(1) = 10#: point3(2) = 0#
    point4(0) = 5#: point4(1) = 5#: point4(2) = 1#

    ' Create the 3DFace object in model space
    Set faceObj =ThisDrawing.ModelSpace.Add3DFace(point1, point2, point3, point4)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll
    MsgBox "Perform the rectangular array on the 3DFACE.", , "ArrayRectangular Example"

    ' Define the rectangular array
    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 = 5
    numberOfColumns = 5
    numberOfLevels = 2
    distanceBwtnRows = 10
    distanceBwtnColumns = 10
    distanceBwtnLevels = 1

    ' Create the array of objects
    Dim retObj As Variant
    Set retObj =ThisDrawing.SelectionSets.Add("new set")
    retObj = faceObj.ArrayRectangular(numberOfRows, numberOfColumns, numberOfLevels, distanceBwtnRows, distanceBwtnColumns, distanceBwtnLevels)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll
    MsgBox "Rectangular array completed.", , "ArrayRectangular Example"

 End Sub

变换对象

在给定的 4*4 转换矩阵的情况下，可以使用 TransformBy 方法来移动、旋转或者缩放对象。创建圆弧，将对象以点（0，0，0）旋转 90 度。

Sub Example_TransformBy()
    ' This example creates a arc and rotates it 90 degrees
    ' using a transformation matrix.

    ' Create the arc
    Dim arcObj As ZcadArc
    Dim centerPoint (0 To 2) As Double
    Dim radius As Double
    Dim startAngleInDegree As Double, endAngleInDegree As Double
    Dim startAngleInRadian As Double, endAngleInRadian As Double

    ' Define the Arc
    centerPoint(0) = 2#: centerPoint(1) = 2#: centerPoint(2) = 0#
    radius = 5#
    startAngleInDegree = 10#: endAngleInDegree = 230#

    ' Convert the angles in degrees to angles in radians
    startAngleInRadian = startAngleInDegree * 3.141592 / 180#
    endAngleInRadian = endAngleInDegree * 3.141592 / 180#

    Set arcObj =ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
    arcObj.Update
    ThisDrawing.Application.ZoomAll

    ' Initialize the transMat variable with a transformation matrix
    ' that will rotate an object by 90 degrees about the point(0,0,0)

    Dim transMat(0 To 3, 0 To 3) As Double
    transMat(0, 0) = 0#: transMat(0, 1) = -1#: transMat(0, 2) = 0#: transMat(0, 3) = 0#
    transMat(1, 0) = 1#: transMat(1, 1) = 0#: transMat(1, 2) = 0#: transMat(1, 3) = 0#
    transMat(2, 0) = 0#: transMat(2, 1) = 0#: transMat(2, 2) = 1#: transMat(2, 3) = 0#
    transMat(3, 0) = 0#: transMat(3, 1) = 0#: transMat(3, 2) = 0#: transMat(3, 3) = 1#

    ' Transform the arc using the defined transformation matrix
    MsgBox "Transform the arc.", , "TransformBy Example"
    arcObj.TransformBy transMat
    ThisDrawing.Application.ZoomAll
    MsgBox "The arc is transformed.", , "TransformBy Example"

End Sub


删除和分解对象

中望CAD 中删除对象的方法有4种，分别是 Delete、Erase、Clear、RemoveItems。其中 Clear 是从选择集中清除项目，但是仍然保留在图形中，它们只是不再与选择集关。RemoveItems 方法是移去选择集中的一项或多项。移去的项目依然存在 DWG 中，但它们已经不在选择集中。Delete 方法可删除选择集对象，而不是选择集中的对象。当调用 Delete 方法后选择集本身已经不存在，但原先在选择集中的项目依然存在。Erase 方法可删除选择集中所有项目。选择集依然存在，但它不包含任何项。原先在选择集中的项目不再存在。

Delete

删除创建的圆弧。

Sub Example_Delete()
    ' This example creates an arc and then deleted

    ' Create the arc
    Dim arcObj As ZcadArc
    Dim centerPoint (0 To 2) As Double
    Dim radius As Double
    Dim startAngleInDegree As Double, endAngleInDegree As Double
    Dim startAngleInRadian As Double, endAngleInRadian As Double

    ' Define the Arc
    centerPoint(0) = 2#: centerPoint(1) = 2#: centerPoint(2) = 0#
    radius = 5#
    startAngleInDegree = 10#: endAngleInDegree = 230#

    ' Convert the angles in degrees to angles in radians
    startAngleInRadian = startAngleInDegree * 3.141592 / 180#
    endAngleInRadian = endAngleInDegree * 3.141592 / 180#

    Set arcObj =ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
    arcObj.Update
    ThisDrawing.Application.ZoomAll
    MsgBox "create the arc", , "Example_Delete"
    arcObj.Delete
    ThisDrawing.Regen zcActiveViewport
    MsgBox "deleted arc ", , "Example_Delete"

End Sub

Clear

清空选择集中的项目。

Sub Example_Clear()

    Dim ssetobj As ZcadSelectionSet
    Set ssetobj = ThisDrawing.SelectionSets.Add("Test")

    ssetobj.SelectOnScreen
    MsgBox "Before delete,The SelectionSet of count is " & ssetobj.Count

    ssetobj.Clear
    MsgBox "After delete,The SelectionSet of count is " & ssetobj.Count

End Sub

Erase

删除圆弧，删除后可以 Regen 重新显示圆弧。

Sub Example_Erase()
    ' This example creates a arc and then Erase
    ' Create the arc
    Dim arcObj As ZcadArc
    Dim centerPoint (0 To 2) As Double
    Dim radius As Double
    Dim startAngleInDegree As Double, endAngleInDegree As Double
    Dim startAngleInRadian As Double, endAngleInRadian As Double

    ' Define the Arc
    centerPoint(0) = 2#: centerPoint(1) = 2#: centerPoint(2) = 0#
    radius = 5#
    startAngleInDegree = 10#: endAngleInDegree = 230#

    ' Convert the angles in degrees to angles in radians
    startAngleInRadian = startAngleInDegree * 3.141592 / 180#
    endAngleInRadian = endAngleInDegree * 3.141592 / 180#

    Set arcObj =ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
    arcObj.Update
    ThisDrawing.Application.ZoomAll
    MsgBox "create the arc", , "Example_Erase"
    arcObj.Erase
    MsgBox "Erase arc ", , "Example_Erase"

End Sub

RemoveItems

删除组内的前两个实体。

Sub Example_RemoveItems()

    Dim gr As ZcadGroup
    If ThisDrawing.Groups.Count > 0 Then
        Set gr =ThisDrawing.Groups.Item(0)
        Else
        Set gr =ThisDrawing.Groups.Add("New_Group")
    End If

    If gr.Count < 1 Then
        MsgBox "No More Item in this Group"
        Exit Sub
    End If
    Dim rent As ZcadEntity
    Dim Str As String

    Dim rents(0 To 1) As ZcadEntity
    Set rents(0) = gr.Item(0)
    Set rents(1) = gr.Item(1)

    GoSub test

    MsgBox "Now We are Removeing ths first two Entities"
    gr.RemoveItems rents
    gr.Update

    GoSub test
    Exit Sub
test:
    Str = "The remaining Entities in this Group are: "
    For I = 0 To gr.Count - 1
        Set rent = gr.Item(I)
        Str = Str & rent.EntityName & " ,"
    Next
    MsgBox Str
    Return

End Sub

可将复合对象，如图块或多段线，从单一对象分解成多个组成元件。分解多段线、矩形、多边形等，使其成为独立的直线与弧的组合，用户可对其中的独立对象进行修改。

Explode

分解 3DPolyline，然后修改分解成多个对象。接着遍历产生的对象，显示含有每个对象名称的消息框，并修改分解后的对象颜色为蓝色。

Sub Example_Explode()

    Dim polyObj As Zcad3DPolyline
    Dim points (0 To 11) As Double

    points(0) = 0: points(1) = 0: points(2) = 0
    points(3) = 10: points(4) = 10: points(5) = 10
    points(6) = 30: points(7) = 20: points(8) = 20
    points(9) = 100: points(10) = 20: points(11) = 20

    ' Create a 3DPolyline in model space
    Set polyObj =ThisDrawing.ModelSpace.Add3DPoly(points)
    ThisDrawing.Regen zcActiveViewport

    ' Explode the 3DPolyline
    MsgBox "Explode the 3DPolyline?", , "Explode Example "

    Dim explodedObjects As Variant
    explodedObjects = polyObj.Explode

    ' Loop through the exploded objects
    Dim I As Integer
    For I = 0 To UBound(explodedObjects)
        MsgBox "Exploded Object " & I & ": " & explodedObjects(I).EntityName, , "Explode Example"
        explodedObjects(I).Color = zcBlue
        explodedObjects(I).Update
    Next

End Sub


延伸对象

用户可以修改直线、圆弧、多段线的长度，也可以更改圆弧的角度。以上操作结果类似于延伸或者修剪对象。用户改变对象的一个或者多个属性后，请使用 Update 方法查看图形中的变化。

延伸对象

创建一个圆弧，修改其起始角度为 45 度

Sub Example_StartAngle()
    ' This example creates an arc and enters the start and
    ' end angles to create an elliptical arc.

    Dim arcObj As ZcadArc
    Dim centerPoint (0 To 2) As Double
    Dim radius As Double
    Dim startAngleInDegree As Double
    Dim endAngleInDegree As Double

    ' Define the circle
    centerPoint(0) = 0#: centerPoint(1) = 0#: centerPoint(2) = 0#
    radius = 5#
    startAngleInDegree = 10#
    endAngleInDegree = 230#

    ' Convert the angles in degrees to angles in radians
    Dim startAngleInRadian As Double
    Dim endAngleInRadian As Double
    startAngleInRadian = startAngleInDegree * 3.141592 / 180#
    endAngleInRadian = endAngleInDegree * 3.141592 / 180#

    ' Create the arc object in model space
    Set arcObj =ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
    ThisDrawing.Regen zcActiveViewport

    'Enter a start angle of 45 degrees
    arcObj.StartAngle = 45 * (3.14 / 180)
    arcObj.Update
    MsgBox "The arc has a start angle of " & arcObj.StartAngle * (180 / 3.14) & " degrees.", vbInformation, "StartAngle Example"

End Sub


编辑多段线和样条曲线

编辑多段线

多段线对象可以进行修改与编辑，例如增加或删除顶点、修改凸度等。下面创建一条多段线，增加多段线的顶点，修改其凸度，修改其宽度

Sub Example_SetBulge()

    Dim lwplineObj As ZcadLWPolyline
    Dim points (0 To 5) As Double
    Dim tpoint (0 To 1) As Double
    tpoint(0) = 2
    tpoint(1)= 1
    points(0) = 3: points(1) = 7
    points(2) = 9: points(3) = 2
    points(4) = 3: points(5) = 5
    Set lwplineObj =ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

    'Add point
    lwplineObj.AddVertex 2, tpoint
    'Alter bulge
    lwplineObj.SetBulge 1, -0.5
    'Alter width
    lwplineObj.SetWidth 2, 0.1, 0.5

    lwplineObj.Update
    ThisDrawing.Regen zcActiveViewport

 End Sub

编辑样条曲线

可以使用样条曲线的属性来更改样条曲线。使用SetControlPoint 修改样条曲线在给定索引的控制点

Sub Example_SetControlPoint()

    ' Create the spline
    Dim plineObj As ZcadSpline
    Dim points (0 To 8) As Double
    Dim startTan (0 To 2) As Double
    Dim endTan (0 To 2) As Double
    startTan(0)= 0.5: startTan(1)= 0.5: startTan(2)= 0
    endTan(0)= 0.5: endTan(1)= 0.5: endTan(2) = 0

    ' Establish the points for the spline
    points(0) = 1: points(1) = 1: points(2) = 0
    points(3) = 5: points(4) = 5: points(5) = 0
    points(6) = 10: points(7) = 0: points(8) = 0

    ' Create the spline in model space
    Set plineObj =ThisDrawing.ModelSpace.AddSpline(points, startTan, endTan)
    plineObj.Update

    ' Display the coordinates of the first control point
    Dim controlPoint As Variant
    controlPoint = plineObj.GetControlPoint(0)
    MsgBox "Control point 1 is at " & controlPoint(0) & ", " & controlPoint(1) & ", " & controlPoint(2), , "SetControlPoint Example"

    ' Change the coordinates of the first fit point
    controlPoint(0) = 0: controlPoint(1) = 3: controlPoint(2) = 0
    plineObj.SetControlPoint 0, controlPoint
    plineObj.Update
    MsgBox "Control point 1 is now at " & controlPoint(0) & ", " & controlPoint(1) & ", " & controlPoint(2), , "SetControlPoint Example"

End Sub


高级应用

在了解一些基本的中望CAD 对象后，可以利用中望CAD 中很多高级功能进一步加强应用程序。可以在图形中创建块、属性、外部引用、填充、光栅图像、三维实体。同时中望CAD 提供了协助用户增加扩展数据的功能。

本章内容包括：

  • 创建块、属性和外部引用
  • 创建光栅图像
  • 创建二维填充和图案填充
  • 编辑填充
  • 三维空间中工作
  • 三维空间中编辑
  • 创建布局和打印设置
  • 创建扩展数据


创建块、属性和外部引用

块就是将多个实体组合成一个整体，并给这个整体命名保存，在以后的图形编辑中这个整体就被视为一个实体。要创建新块，请使用Add方法。此方法有两个输入参数，分别是块的位置和块名。创建块后，可以向其中添加对象，然后可以使用InsertBlock方法将块或者整个图形插入到当前图形中。InsertBlock方法的参数有六个，分别是：插入点、要插入的块或者图形的名称、X、Y、Z比例因子以及旋转角度。

创建块参照

定义一个块并把圆添加到块定义中，然后将块插入当前图形中。块定义中的圆将被更新，块参照也会自动更新。

Sub Example_InsertBlock()
    ' Create the block
    Dim blockObj As ZcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    Set blockObj =ThisDrawing.Blocks.Add(insertionPnt, "CircleBlock")

    ' Add a circle to the block
    Dim circleObj As ZcadCircle
    Dim center(0 To 2) As Double
    Dim radius As Double
    center(0) = 0: center(1) = 0: center(2) = 0
    radius = 10
    Set circleObj = blockObj.AddCircle(center, radius)

    ' Insert the block
    Dim blockRefObj As ZcadBlockReference
    insertionPnt(0) = 100#: insertionPnt(1) = 100#: insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)

    circleObj.radius = 100
    circleObj.Color = zcRed
    blockRefObj.Update
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

定义一个块并把圆和直线添加到块定义中，然后将块插入当前图形中。接着块参照被分解，修改分解生成的对象的颜色并显示对象类型。

Sub Example_Explodeblock()
    ' Create the block
    Dim blockObj As ZcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    Set blockObj =ThisDrawing.Blocks.Add(insertionPnt, "CircleBlock")

    ' Add a circle to the block
    Dim circleObj As ZcadCircle
    Dim center(0 To 2) As Double
    Dim radius As Double
    center(0) = 0: center(1) = 0: center(2) = 0
    radius = 10
    Set circleObj = blockObj.AddCircle(center, radius)

    ' Add a line to the block
    Dim lineobj As ZcadLine
    Dim st (0 To 2) As Double
    Dim et (0 To 2) As Double
    st(0) = 0: st(1) = 0: st(2) = 0
    et(0) = 100: et(1) = 100: et(2) = 0
    Set lineboj = blockObj.AddLine(st, et)

    ' Insert the block
    Dim blockRefObj As ZcadBlockReference
    insertionPnt(0) = 100#: insertionPnt(1) = 100#: insertionPnt(2) = 0
    Set blockRefObj =ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)

    ' Explode blockobj
    Dim explodeobj As Variant
    Set explodeobj =ThisDrawing.SelectionSets.Add("test")
    explodeobj = blockRefObj.Explode

    Dim i As Integer
    For i = 0 To UBound(explodeobj)
        explodeobj(i).Color = zcBlue
        explodeobj(i).Update
        MsgBox explodeobj(i).EntityName
    Next

    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

一个零件符号除自身的几何形状外，还包含很多参数和文字说明信息（规格、型号、技术说明等），中望CAD 系统将块所含的附加信息称为属性。

属性参照

要想获取属性参照，首先必须使用 AddAttribute 方法在块上创建属性定义。此方法需要输入六个参数：属性文字的高度、模式、提示字符串、插入点、标记字符串和默认属性值。属性的模式是可选的，可以输入五个常量来指定属性模式：

  • zcAttributeModeNormal：指定保留每个属性的当前模式
  • zcAttributeModeInvisible：指定在用户插入块时不显示属性值
  • zcAttributeModeConstant：在插入块时赋予属性固定值
  • zcAttributeModeVerify：在插入块时，提示验证属性值是否正确
  • zcAttributeModePreset：当用户插入包含当前属性的块时，将属性设置为其默认值。在此模式下不能编辑该值

创建一个块，然后向块中添加属性。然后把属性块插入到图形中，然后返回属性数据，块参照中的属性数据将被更新，并再次返回和显示属性数据。

Sub Example_GetAttributes()

    ' Create the block
    Dim blockObj As ZcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    On Error Resume Next

    Dim newBlock As ZcadBlock
    BlockObjName = "New_blockName"
    Err.Clear
    Set blockObj =ThisDrawing.Blocks.Add(insertionPnt, BlockObjName)
    If Err <> 0 Then
      ThisDrawing.Blocks.Item(BlockObjName).Delete
      Set blockObj =ThisDrawing.Blocks.Add(insertionPnt, BlockObjName)
    End If

    ' Define the attribute definition
    Dim attributeObj As ZcadAttribute
    Dim height As Double
    Dim mode As ZcAttributeMode
    Dim prompt As String
    Dim insertionPoint(0 To 2) As Double
    Dim tag As String
    Dim value As String
    height = 1#
    mode = zcAttributeModeVerify
    prompt = "Attribute Prompt"
    insertionPoint(0) = 5#: insertionPoint(1) = 5#: insertionPoint(2) = 0
    tag = "Attribute Tag"
    value = "Attribute Value"

    ' Create the attribute definition object in model space
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag, value)

    On Error GoTo 0
    ' Insert the block
    Dim blockRefObj As ZcadBlockReference
    insertionPnt(0) = 100#: insertionPnt(1) = 100#: insertionPnt(2) = 0
    Set blockRefObj =ThisDrawing.ModelSpace.InsertBlock(insertionPnt, BlockObjName, 1#, 1#, 1#, 0)
    ThisDrawing.Regen zcActiveViewport

    ' Get the attributes for the block reference
    Dim varAttributes As Variant
    varAttributes = blockRefObj.GetAttributes
    Dim temp As String
    Dim i As Integer
    For i = LBound(varAttributes) To UBound(varAttributes)
        temp = temp & "  Tag: " & varAttributes(i).TagString & _
                        "   Value: " & varAttributes(i).TextString & "    "

    Next

    MsgBox temp
    Dim newvarAttributes As Variant

    newvarAttributes = blockRefObj.GetAttributes
    newvarAttributes(0).TextString = "New_test"
    temp = ""
    For i = LBound(varAttributes) To UBound(varAttributes)
        temp = temp & "  Tag: " & varAttributes(i).TagString & _
                        "   Value: " & varAttributes(i).TextString & "    "

    Next

    MsgBox temp
End Sub

外部参照就是将整个图形附着或覆盖到当前的图形。打开当前图时，参照图形中所做的任何更改都会出现在当前图形中。

外部参照

附着外部参照，并遍历插入后当前图形中所有的块。

Sub Example_AttachExternalReference()

    Dim InsertPoint (0 To 2) As Double
    Dim insertedBlock As ZcadExternalReference
    Dim tempBlock As ZcadBlock
    Dim msg As String, PathName As String

    InsertPoint(0) = 100: InsertPoint(1) = 100: InsertPoint(2) = 0
    PathName = "C:\boot\123.dwg"
    Set insertedBlock =ThisDrawing.ModelSpace.AttachExternalReference(PathName, "Test", InsertPoint, 1, 1, 1, 0, False)

    For Each tempBlock In ThisDrawing.Blocks
        msg = msg & tempBlock.name & vbCrLf
    Next
    MsgBox "The current blocks in this drawing are: " & vbCrLf & msg

End Sub
  • 通过 Detach 方法可以拆离外部参照
  • 通过 Reload 方法可以重载外部参照
  • 通过 Unload 方法可以卸载外部参照
  • 通过 Bind 方法可以绑定外部参照


创建光栅图像

光栅图像由一些称为像素的小方块或点的矩形栅格组成。可以使用 AddRaster 方法在图形中创建 Raster 对象。在图形中附着光栅图像与附着外部参照类似，都只是附着了一个路径，不属于图形文件的实际组成部分。在当前图形中间附着光栅图像后，附着的图像如同插入的块文件一样，可以多次附着同一个图像文件。可对附着的光栅图像进行剪裁，进行亮度、对比度、褪色度和透明度的相关设置。

创建光栅图像

在模型空间中添加光栅图像

Sub Example_AddRaster()

    Dim insertionPoint (0 To 2) As Double
    Dim scalefactor As Double
    Dim rotationAngle As Double
    Dim imageName As String
    Dim rasterObj As ZcadRasterImage
    imageName = "C:\boot\test.jpg"
    insertionPoint(0) = 100#: insertionPoint(1) = 100#: insertionPoint(2) = 0#
    scalefactor = 1#
    rotationAngle = 0

    On Error Resume Next
    ' Creates a raster image in model space
    Set rasterObj =ThisDrawing.ModelSpace.AddRaster(imageName, insertionPoint, scalefactor, rotationAngle)

    If Err.Description = "File error" Then
        MsgBox imageName & " could not be found."
        Exit Sub
    End If
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

下面一些属性可以修改Raster特性：

属性名称 | 属性的作用
ClippingEnabled | 指定是否隐藏图像边界
Layer | 指定图像的图层
Color | 指定图像边界的颜色
Linetype | 指定图像的线型
ScaleFactor | 指定图像的缩放比例
Rotation | 指定图像的旋转角度
Origin | 指定图像位置
Width | 以像素为单位指定图像的宽度
Height | 以像素为单位指定图像的高度
ImageWidth | 使用数据库单位指定图像的宽度
ImageHeight | 使用数据库单位指定图像的高度
ShowRotation | 确定是否旋转显示光栅
Brightness | 指定图像的亮度级别
Contrast | 指定图像的对比度级别
Fade | 指定图像的褪色度级别


创建二维填充和图案填充

实体填充对象就是经过二维填充的三角形或者四边形对象。用户可以通过AddSolid方法来创建二维填充实体，有关填充实体的详细信息，请参见《用户手册》中的相关内容。

创建实体填充

在模型空间中创建二维填充。

Sub Example_AddSolid()

    Dim solidObj As ZcadSolid
    Dim point1 (0 To 2) As Double
    Dim point2 (0 To 2) As Double
    Dim point3 (0 To 2) As Double
    Dim point4 (0 To 2) As Double

    ' Define the solid
    point1(0) = 1#: point1(1) = 1#: point1(2) = 0#
    point2(0) = 6#: point2(1) = 3#: point2(2) = 0#
    point3(0) = 7#: point3(1) = 8#: point3(2) = 0#
    point4(0) = 3#: point4(1) = 9#: point4(2) = 0#

    ' Create the solid object in model space
    Set solidObj =ThisDrawing.ModelSpace.AddSolid(point1, point2, point3, point4)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

图案填充可以使用某种图案来填充图形中的指定区域。在创建图案填充时，不是在开始的时候指定要填充的区域。首先必须创建 Hatch 对象。完成后，可以指定外部环，这是图案填充最外面的边界。然后继续指定图案填充中可能存在的所有内部环。用户可以通过 AddHatch 方法来创建 Hatch 对象，该方法需要指定填充图案类型、填充图案名和关联性。

创建图案填充

在模型空间中创建图案填充。

Sub Example_AddHatch()
    'Create the pattern hatch object

    Dim hatchobj As ZcadHatch
    Dim patternname As String
    Dim patterntype As Long
    Dim bassociativity As Boolean

    'Define the hatch
    patternname = "SOLID"
    patterntype = zcHatchPatternTypePreDefined
    bassociativity = True

    'Create the associative hatch object
    Set hatchobj =ThisDrawing.ModelSpace.AddHatch(patterntype, patternname, bassociativity)

    'Create the lightweightPolyline as the outer loop for the hatch
    Dim outerloop As ZcadLWPolyline
    Dim object(0 To 0) As ZcadEntity
    Dim points(0 To 5) As Double

    points(0) = 1: points(1) = 1
    points(2) = 3: points(3) = 3
    points(4) = 2: points(5) = 1.5

    Set outerloop =ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
    outerloop.Closed = True
    outerloop.Update
    Set object(0) = outerloop

    'Append the outer loop to the hatch
    hatchobj.AppendOuterLoop (object)
    ThisDrawing.Regen zcActiveViewport

End Sub


编辑填充

用户可以编辑图案的填充边界和填充图案。编辑关联图案的填充的边界，只要编辑的结果是有效的边界，那么图案就会更新。

编辑填充

下面示例创建图案填充后，创建一个圆，并将该圆作为内部环附加到图案填充，修改填充角度为 30 度。

Sub Example_PatternAngle()

    Dim hatchobj As ZcadHatch
    Dim patternname As String
    Dim patterntype As Long
    Dim bassociativity As Boolean

    'Define the hatch
    patternname = "ANSI31"
    patterntype = zcHatchPatternTypePreDefined
    bassociativity = True

    'Create the associative hatch object
    Set hatchobj =ThisDrawing.ModelSpace.AddHatch(patterntype, patternname, bassociativity)
    Dim outerloop(0 To 1) As ZcadEntity
    Dim center(0 To 2) As Double
    Dim arcobj As ZcadArc
    Dim startangle As Double
    Dim endangle As Double

    center(0) = 5
    center(1) = 3
    center(2) = 0
    startangle = 0
    endangle = 3.141592

    Set outerloop(0) =ThisDrawing.ModelSpace.AddArc(center, 3, starangle, endangle)
    Set arcobj = outerloop(0)
    Set outerloop(1) =ThisDrawing.ModelSpace.AddLine(arcobj.startpoint, arcobj.endpoint)

    'Append the outer loop to the hatch
    hatchobj.AppendOuterLoop (outerloop)
    Dim innerloop(0) As ZcadEntity
    center(0) = 5
    center(1) = 4.5
    center(2) = 0
    Set innerloop(0) =ThisDrawing.ModelSpace.AddCircle(center, 1)

    'Append the inner loop to the hatch
    hatchobj.AppendInnerLoop (innerloop)

    'Change the hatch angle to 30 degree
    hatchobj.patternAngle = (30 / 180) * 3.1415926
    hatchobj.Evaluate
    ThisDrawing.Regen zcActiveViewport

End Sub


三维空间中工作

大部分图形都是由三维对象的二维视图组成。虽然此种绘图方法广泛用于建筑和工程领域，但是它也受到限制，图形是三维对象的二维表示形式，并且必须进行可视解释。而且，由于视图是分别绘制的，因此很有可能出现错误或者表达不清楚。因此使用中望CAD 的绘图工具可以创建真实、详尽的三维对象，并且能够以多种方式对其进行处理。三维空间的坐标指定与在二维空间的操作相似，不同之处在于除 了指定X和Y值以外，还要指定Z值。

创建新的 UCS

可通过指定原点(0,0,0)和方向定义一个不同于世界坐标系WCS的用户坐标系 UCS，下面创建一个新的 UCS，并将其设置为图形的活动 UCS。在图形中获取一点，返回该点的 UCS 和 WCS 的坐标。

Sub Example_TranslateCoordinates()

    Dim ucsObj As ZcadUCS
    Dim origin(0 To 2) As Double
    Dim xAxisPnt(0 To 2) As Double
    Dim yAxisPnt(0 To 2) As Double

    ' Define the UCS
    origin(0) = 10#: origin(1) = 10#: origin(2) = 2#
    xAxisPnt(0) = 20#: xAxisPnt(1) = 10#: xAxisPnt(2) = 2#
    yAxisPnt(0) = 10#: yAxisPnt(1) = 16#: yAxisPnt(2) = 2#

    Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "Test1")
    ThisDrawing.ActiveViewport.UCSIconOn = True
    ThisDrawing.ActiveViewport.UCSIconAtOrigin = True
    ThisDrawing.ActiveUCS = ucsObj
    Dim pointWCS As Variant
    pointWCS =ThisDrawing.Utility.GetPoint(, "Enter a point to translate:")
    Dim pointUCS As Variant
    pointUCS =ThisDrawing.Utility.TranslateCoordinates(pointWCS, zcWorld, zcUCS, False)

    MsgBox "The point has the following coordinates:" & vbCrLf & _
            "WCS: " & pointWCS(0) & ", " & pointWCS(1) & ", " & pointWCS(2) & vbCrLf & _
            "UCS: " & pointUCS(0) & ", " & pointUCS(1) & ", " & pointUCS(2), , "TranslateCoordinates Example"

End Sub

创建三维对象的方法有很多，下面介绍其中的几种方法。具体创建三维对象的方法详见中望CAD VBA 参考。

创建三维对象

在模型空间中用Add3DFace来创建三维面

Sub Example_Add3DFace()
    ' This example creates a 3D face in model space.

    Dim faceObj As Zcad3DFace
    Dim point1(0 To 2) As Double
    Dim point2(0 To 2) As Double
    Dim point3(0 To 2) As Double
    Dim point4(0 To 2) As Double

    ' Define the four coordinates of the face
    point1(0) = 1#: point1(1) = 1#: point1(2) = 0#
    point2(0) = 5#: point2(1) = 0#: point2(2) = 10#
    point3(0) = 3#: point3(1) = 20#: point3(2) = 0#
    point4(0) = 6#: point4(1) = 6#: point4(2) = 20#

    ' Create the 3DFace object in model space
    Set faceObj =ThisDrawing.ModelSpace.Add3DFace(point1, point2, point3, point4)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

在模型空间中用AddBox方法创建长方体。

Sub Example_AddBox()
    ' This example creates a box in model space.

    Dim boxObj As Zcad3DSolid
    Dim length As Double, width As Double, height As Double
    Dim center (0 To 2) As Double

    ' Define the box
    center(0) = 4#: center(1) = 4#: center(2) = 0
    length = 10#: width = 5#: height = 20#

    ' Create the box object in model space
    Set boxObj =ThisDrawing.ModelSpace.AddBox(center, length, width, height)

    ' Change the viewing direction of the viewport to better see the box
    Dim NewDirection(0 To 2) As Double
    NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
    ThisDrawing.ActiveViewport.Direction = NewDirection
    ThisDrawing.ActiveViewport =ThisDrawing.ActiveViewport
    ThisDrawing.Regen zcActiveViewport

End Sub

在模型空间中用 AddBox 方法创建长方体。

Sub Example_AddBox()
    ' This example creates a box in model space.

    Dim boxObj As Zcad3DSolid
    Dim length As Double, width As Double, height As Double
    Dim center (0 To 2) As Double

    ' Define the box
    center(0) = 4#: center(1) = 4#: center(2) = 0
    length = 10#: width = 5#: height = 20#

    ' Create the box object in model space
    Set boxObj = ThisDrawing.ModelSpace.AddBox(center, length, width, height)

    ' Change the viewing direction of the viewport to better see the box
    Dim NewDirection(0 To 2) As Double
    NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
    ThisDrawing.ActiveViewport.Direction = NewDirection
    ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
    ThisDrawing.Regen

End Sub

在模型空间用AddPolyfaceMesh方法创建多面网格。

Sub Example_AddPolyfaceMesh()

    Dim vertexList(0 To 17) As Double
    vertexList(0) = 4: vertexList(1) = 7: vertexList(2) = 0
    vertexList(3) = 5: vertexList(4) = 7: vertexList(5) = 0
    vertexList(6) = 6: vertexList(7) = 7: vertexList(8) = 1
    vertexList(9) = 4: vertexList(10) = 10: vertexList(11) = 0
    vertexList(12) = 5: vertexList(13) = 10: vertexList(14) = 0
    vertexList(15) = 6: vertexList(16) = 10: vertexList(17) = 0

    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 obj As ZcadPolyfaceMesh
    Set obj = ThisDrawing.ModelSpace.AddPolyfaceMesh(vertexList, FaceList)
    ThisDrawing.Regen zcActiveViewport

    ' Change the viewing direction of the viewport to
    ' better see the polyface mesh
    Dim NewDirection(0 To 2) As Double
    NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
    ThisDrawing.ActiveViewport.Direction = NewDirection
    ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

在模型空间中用Add3DMesh方法创建三维网格。

Sub Example_Add3DMesh()
    ' This example creates a 4 X 4 polygonmesh in model space.

    Dim meshObj As ZcadPolygonMesh
    Dim mSize, nSize, count As Integer
    Dim Points(0 To 47) As Double

    ' Create the matrix of points
    Points(0) = 1: Points(1) = 0: Points(2) = 0
    Points(3) = 3: 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) = 1: Points(13) = 4: Points(14) = 0
    Points(15) = 3: 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) = 1: Points(25) = 6: Points(26) = 0
    Points(27) = 3: 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) = 1: Points(37) = 8: Points(38) = 0
    Points(39) = 3: 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

    ' Creates a 3Dmesh in model space
    Set meshObj = ThisDrawing.ModelSpace.Add3DMesh(mSize, nSize, Points)

    ' Change the viewing direction of the viewport to better see the polygonmesh
    Dim NewDirection(0 To 2) As Double
    NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
    ThisDrawing.ActiveViewport.Direction = NewDirection
    ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub


三维空间中编辑

在中望CAD 中创建对象后，可以用 Rotate3D、Mirror3D、ArrayRectangular 方法来编辑对象。CheckInterference 方法来创建干涉实体。

三维空间编辑

创建一圆弧，然后绕旋转轴旋转40度。

Sub Example_Rotate3D()

    ' Create the arc
    Dim arcObj As ZcadArc
    Dim centerPoint(0 To 2) As Double
    Dim radius As Double
    Dim startAngleInDegree As Double, endAngleInDegree As Double
    Dim startAngleInRadian As Double, endAngleInRadian As Double

    ' Define the Arc
    centerPoint(0) = 2#: centerPoint(1) = 2#: centerPoint(2) = 0#
    radius = 5#
    startAngleInDegree = 10#: endAngleInDegree = 230#

    ' Convert the angles in degrees to angles in radians
    startAngleInRadian = startAngleInDegree * 3.141592 / 180#
    endAngleInRadian = endAngleInDegree * 3.141592 / 180#

    Set arcObj = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
    ThisDrawing.Regen zcActiveViewport

    ' Define the rotation axis with two points
    Dim rotatePt1(0 To 2) As Double
    Dim rotatePt2(0 To 2) As Double
    Dim rotateAngle As Double

    rotatePt1(0) = 8: rotatePt1(1) = 9: rotatePt1(2) = 0
    rotatePt2(0) = 8: rotatePt2(1) = -3: rotatePt2(2) = 0
    rotateAngle = 40
    rotateAngle = rotateAngle * 3.141592 / 180#

    Dim NewDirection(0 To 2) As Double
    NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
    ThisDrawing.ActiveViewport.Direction = NewDirection
    ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
    ThisDrawing.Regen zcActiveViewport

    ' Rotate the arc
    arcObj.Rotate3D rotatePt1, rotatePt2, rotateAngle
    arcObj.Update
    ThisDrawing.Regen zcActiveViewport
    MsgBox "The arc is rotated 40 degrees.", , "Rotate3D Example"

End Sub

创建一个圆，根据某个平面镜像该圆，并将镜像得到的圆着色为蓝色

Sub Example_Mirror3D()
    ' This example creates a Circle in model space, and mirrors the Circle about a plane.
    ' Create the Circle.

    Dim circleObj As ZcadCircle
    Dim centerPoint(0 To 2) As Double
    Dim radius As Double

    ' Define the circle
    centerPoint(0) = 10#: centerPoint(1) = 10#: centerPoint(2) = 0#
    radius = 30#

    ' Create the Circle object in model space
    Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

    ' Define the mirroring plane with three points
    Dim mirrorPt1(0 To 2) As Double
    Dim mirrorPt2(0 To 2) As Double
    Dim mirrorPt3(0 To 2) As Double
    mirrorPt1(0) = 100: mirrorPt1(1) = 0: mirrorPt1(2) = 0
    mirrorPt2(0) = 100: mirrorPt2(1) = 200: mirrorPt2(2) = 0
    mirrorPt3(0) = 100: mirrorPt3(1) = 200: mirrorPt3(2) = 200

    ' Mirror the Circle
    Dim mirrorarcObj As ZcadCircle
    Set mirrorarcObj = circleObj.Mirror3D(mirrorPt1, mirrorPt2, mirrorPt3)
    mirrorarcObj.Color = zcBlue
    mirrorarcObj.Update

    ' Change the viewing direction of the viewport
    Dim NewDirection(0 To 2) As Double
    NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
    ThisDrawing.ActiveViewport.Direction = NewDirection
    ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
    ThisDrawing.Regen zcActiveViewport
    ThisDrawing.Application.ZoomAll

End Sub

创建长方体和圆柱体，使用CheckInterference方法创建干涉实体，标记为红色。

Sub Example_CheckInterference()

    Dim boxObj As Zcad3DSolid
    Dim boxLength As Double, boxWidth As Double, boxHeight As Double
    Dim boxCenter(0 To 2) As Double
    boxCenter(0) = 5#: boxCenter(1) = 5#: boxCenter(2) = 0
    boxLength = 10#: boxWidth = 7: boxHeight = 10#

   ' Create the box (3DSolid) object in model space
    Set boxObj = ThisDrawing.ModelSpace.AddBox(boxCenter, boxLength, boxWidth, boxHeight)
    boxObj.Color = zcBlue
    boxObj.Update

   ' Define the cylinder
    Dim cylinderObj As Zcad3DSolid
    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 = 5#
    cylinderHeight = 20#

    ' Create the Cylinder (3DSolid) object in model space
    Set cylinderObj = ThisDrawing.ModelSpace.AddCylinder(cylinderCenter, cylinderRadius, cylinderHeight)
    cylinderObj.Color = zcGreen
    cylinderObj.Update

    ' Find the interference between the two solids and create a new solid from it
    Dim solidObj As Zcad3DSolid
    Set solidObj = boxObj.CheckInterference(cylinderObj, True)
    solidObj.Color = zcRed

    ' Change the viewing direction of the viewport
    Dim NewDirection(0 To 2) As Double
    NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
    ThisDrawing.ActiveViewport.Direction = NewDirection
    ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
    ThisDrawing.Regen zcActiveViewport

End Sub


创建布局和打印设置

用户可以从创建图形的模型空间直接将图形打印出来，或者通过创建自定义的布局视口打印图形。

创建布局

创建一个新的布局，并把其设为活动的

Sub Example_Addlayout()

  Dim layoutobj As ZcadLayout
  Set layoutobj = ThisDrawing.Layouts.Add("Test")
  ThisDrawing.ActiveLayout = layoutobj

End Sub

布局配置

布局设置控制打印输出，下面介绍其常用的属性

  • ConfigName属性指定打印机
  • CanonicalMediaName属性指定图纸尺寸
  • PaperUnits属性来指定布局的单位
  • PlotOrigin属性指定打印原点
  • PlotType属性设置打印区域
  • StandardScale 设置标准比例
  • SetCustomScale 设置自定义比例

Layout所有配置可以通过其方法和属性来设置，具体详见中望CAD VBA参考

视口

在模型空间操作时，屏幕上只显示一个单一的视图。如果想创建附加的视口将图形中的各个部位分别显示，可以将模型空间分割成多个窗口，每个窗口中均可将原图形放大或缩小以显示不同部位。当切换到布局选项卡上时，必须在布局中创建至少一个视口将模型空间的图形显示出来。每个视口的功能就像模型空间的一个窗口，可单独对每个视口中的对象进行移动、复制或者删除。模型空间中的视口在 ActiveX Automation 中称为 Viewport 对象。图纸空间中的视口在 ActiveX Automation 中称为 PViewport。在模型空间中创建视口

Sub Example_Viewport()

    Dim viewportObj As ZcadViewport
    Set viewportObj = ThisDrawing.Viewports.Add("Test")
    MsgBox viewportObj.Name

End Sub

在图纸空间中创建视口

Sub Example_AddPViewport()
    ' This example creates a new paper space viewport

    Dim pviewportObj As ZcadPViewport
    Dim center(0 To 2) As Double
    Dim width As Double
    Dim height As Double

    ' Define the paper space viewport
    center(0) = 3: center(1) = 3: center(2) = 0
    width = 40
    height = 40

    ' Change from model space to paper space
    ThisDrawing.ActiveSpace = zcPaperSpace

    ' Create the paper space viewport
    Set pviewportObj = ThisDrawing.PaperSpace.AddPViewport(center, width, height)
    ThisDrawing.Regen zcActiveViewport

End Sub

打印图形

在图形中创建或修改对象完成后，可在图纸上打印图形，并设置打印的相关属性。Plot 对象常用的属性和方法如下：

  • PlotToFile 打印到文件
  • PlotToDevice 打印到设备
  • DisplayPlotPreview 显示指定打印的预览


创建扩展数据

扩展数据用作链接信息与图形中对象的方式。可以通过 SetXData 方法设置与对象关联的扩展数据，通过 GetXData 方法获取与对象关联的扩展数据。

创建扩展数据

在模型空间创建一个圆弧，把扩展数据附着到圆弧上

Sub Example_SetAndGetXData()
    ' This example creates a arc and attaches extended data to that arc.
    ' Create the arc
    Dim arcObj As ZcadArc
    Dim centerPoint(0 To 2) As Double
    Dim radius As Double
    Dim startAngleInDegree As Double, endAngleInDegree As Double
    Dim startAngleInRadian As Double, endAngleInRadian As Double

    ' Define the Arc
    centerPoint(0) = 2#: centerPoint(1) = 2#: centerPoint(2) = 0#
    radius = 5#
    startAngleInDegree = 10#: endAngleInDegree = 230#

    ' Convert the angles in degrees to angles in radians
    startAngleInRadian = startAngleInDegree * 3.141592 / 180#
    endAngleInRadian = endAngleInDegree * 3.141592 / 180#

    Set arcObj = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
    arcObj.Update
    ThisDrawing.Application.ZoomAll

    ' Initialize all the xdata values. Note that first data in the list should be
    ' application name and first datatype code should be 1001
    Dim DataType(0 To 9) As Integer
    Dim Data(0 To 9) As Variant
    Dim reals3(0 To 2) As Double
    Dim worldPos(0 To 2) As Double

    DataType(0) = 1001: Data(0) = "Test-Application"
    DataType(1) = 1000: Data(1) = "This is a test for xdata"
    DataType(2) = 1003: Data(2) = "0"
    DataType(3) = 1040: Data(3) = 1.2345678912121212
    DataType(4) = 1041: Data(4) = 123456789
    DataType(5) = 1070: Data(5) = 32767
    DataType(6) = 1071: Data(6) = 65534
    DataType(7) = 1042: Data(7) = 100

    reals3(0) = -100.23: reals3(1) = 100.23: reals3(2) = -20
    DataType(8) = 1010: Data(8) = reals3

    worldPos(0) = 200.23: worldPos(1) = 200.23: worldPos(2) = -10
    DataType(9) = 1011: Data(9) = worldPos

    ' Attach the xdata to the arc
    arcObj.SetXData DataType, Data

    ' Return the xdata for the arc
    Dim xdataOut As Variant
    Dim xtypeOut As Variant
    arcObj.GetXData "", xtypeOut, xdataOut

End Sub


VBA 示例程序

通过本示例程序来演示如何使用 Visual Basic for Applications (VBA) 以及如何向中望CAD 添加宏。本示例程序是要给图纸中的各种不同字体高度，不同旋转角度的单行文字加上外框并标注外框的长和宽。

本章内容包括：

  • 检查环境和定义目标
  • 获取屏幕选择
  • 添加对话框
  • 计算以及绘制图
  • 执行宏


检查环境和定义目标

对于本教程，需要用户安装中望CAD 专业版本才能提供集成式开发环境（VBA IDE）。启动中望CAD ，在命令行输入 VBA 或者 VBAIDE，并按回车（Enter）键。如果打开 VBA IDE，表明已安装了 VBA IDE。

本教程的目标是为中望CAD 添加一个新宏，用于给图纸中的各种不同字体高度，不同旋转角度的单行文字加上外框并标注外框的长和宽。新宏将提供下列提示序列：

  1. 运行新宏。
  2. 用户在模型空间中选择单行文字实体。
  3. 弹出对话框，用户输入标注文字的颜色。
  4. 经过这些操作后，便可以实现在上述定的目标。


获取屏幕选择

为了在屏幕选择实体，要用到 ZwcadSelectionSet 对象和 SelectOnScreen 方法。首先，创建一个选择集，用于存放选择到的实体。被选中的实体亮显，如下图所示：

相应代码如下：

On Error Resume Next
Err.Clear
Set ssetobj =ThisDrawing.SelectionSets.Add("New_Select")
If Err <> 0 Then
ThisDrawing.SelectionSets.Item("New_Select").Delete
Set ssetobj =ThisDrawing.SelectionSets.Add("New_Select")
End If
On Error GoTo 0         '取消当前的错误处理程序

ssetobj.Clear
ssetobj.SelectOnScreen  '选择对象到新建的选择集里


添加对话框

要添加对话框，需要使用 VBA IDE 中的窗体。本示例中需要创建的对话框包含一个文本框，用于输入标注文字的颜色。两个命令按钮，一个标签。

从 VBA IDE 中创建对话框的步骤

  1. 在“插入”菜单中，单击“用户窗体”打开一个新窗体。将显示两个窗口、一个工具箱和一个空用户窗体。

  2. 从工具箱中依次选择拖动下列控件，将它们放到用户窗体中。如下面的窗体所示放置一个标签（ [image] ）、一个文本框（ [image] ）和两个命令按钮（ [image] ） ：

  3. 关闭工具箱。

    • 为标签控件设置特性的步骤

      在用户窗体中，选择“Label1”控件。在“特性”窗口中，为Label1更改下列特性：

      名称=lab_dimtxtcolor

      Caption=标注文字的颜色（请输入颜色索引）

    • 为文本框控件设置特性的步骤

      在用户窗体中，选择“TextBox1控件。在“特性”窗口中，为TextBox1更改下列特性：

      名称=dimtextcolor

      Text=1

    • 为命令按钮控件和窗体窗口设置特性的步骤

      在用户窗体中，选择“CommandButton1”控件。在“特性”窗口中，更改CommandButton1的下列特性：

      名称=ok_CommandButton1

      Caption = OK

      Default=True

      在用户窗体中，选择“CommandButton2”控件。在“特性”窗口中，更改CommandButton2的下列特性：

      名称 = cancel_CommandButton2

      Caption = Cancel

      Cancel=True

      在窗体背景中所有控件之外的位置单击以选择用户窗体。在“特性”窗口中，更改窗体的下列特性：

      名称 = textframe

      Caption = 文字外框选项

      现在窗体应如下所示：

  4. 保存所做的工作。


计算及绘制图

本示例的几点主要处理过程如下

  1. 保存标注文字颜色
    2. Private Sub ok_CommandButton1_Click()
Textframe.Hide
Err.Clear
On Error Resume Next
tmpnewtxtcolor = dimtextcolor.text  '保存颜色
If Err <> 0 Then   '假如输入的类型不对，便还原默认值
      tmpnewtxtcolor = 1
      dimtextcolor.text = 1
End If
On Error GoTo 0
  2. 使用循环结构处理选择集中的实体并过滤不是单行文字的实体
    3. For i = 0 To ssetobj.Count - 1 '遍历选择集实体

Set tmpentobj = ssetobj.Item(i)
If StrComp(tmpentobj.EntityName, "Text", 1) = 0 Then  '过滤其它实体

Set tmptxtobj = tmpentobj
insertpoint = tmptxtobj.InsertionPoint  '获取文字的插入点

tmp = tmptxtobj.Rotation  '保存旋转角度，是为了进行一些操作后还原初始状态
tmptxtobj.Rotation = 0    '把文字转到水平上，是为了更好的计算出文字外框的四个顶点
tmptxtobj.Update
End If
  3. 处理点和处理对象的信息
    4. tmptxtobj.GetBoundingBox nt, mt  '返回单行文字边框的最大和最小点

pt1(0) = nt(0)
pt1(1) = nt(1)
pt2(0) = mt(0)
pt2(1) = nt(1)
pt3(0) = mt(0)
pt3(1) = mt(1)
pt4(0) = nt(0)
pt4(1) = mt(1)

Dim pts(0 To 14) As Double
pts(0) = pt1(0): pts(1) = pt1(1): pts(2) = 0
pts(3) = pt2(0): pts(4) = pt2(1): pts(5) = 0
pts(6) = pt3(0): pts(7) = pt3(1): pts(8) = 0
pts(9) = pt4(0): pts(10) = pt4(1): pts(11) = 0
pts(12) = pt1(0): pts(13) = pt1(1): pts(14) = 0

Dim plineobj As ZcadPolyline
Set plineobj = ThisDrawing.ModelSpace.AddPolyline(pts)
plineobj.Update

tmptxtobj.Rotation = tmp  '还原文字的旋转角度
tmptxtobj.Update

plineobj.Rotate insertpoint, tmp  '为了能准确的画出文字的边框，必须得进行旋转操作
plineobj.Update

Dim dimobject1 As ZcadDimAligned
Dim dimobject2 As ZcadDimAligned
Dim txtpoint (0 To 2) As Double
Dim high As Double

high = tmptxtobj.Height  '获取文字的高度
 '计算文字的插入点
txtpoint(0) = pt1(0)
txtpoint(1)= pt1(1) - 0.8 * high
txtpoint(2) = 0

Set dimobject1 = ThisDrawing.ModelSpace.AddDimAligned(pt1, pt2, txtpoint)
dimobject1.TextHeight = 0.25 * high
dimobject1.TextColor = tmpnewtxtcolor
dimobject1.Update
dimobject1.Rotate insertpoint, tmp  '为了使标注能准确地表示文字的外框，必须得进行旋转操作

txtpoint(0) = pt3(0) + 0.8 * high
txtpoint(1)= pt3(1)
txtpoint(2) = 0
Set dimobject2 = ThisDrawing.ModelSpace.AddDimAligned(pt2, pt3, txtpoint)
dimobject2.TextHeight = 0.25 * high
dimobject2.TextColor = tmpnewtxtcolor
dimobject2.Update
dimobject2.Rotate insertpoint, tmp
ThisDrawing.Regen


执行宏

各个子例程完成后，可以合并到 Run_TextFrame 宏中。在 VBA IDE 的“代码”窗口中

 Sub Run_TextFrame()

   Call Draw.DrawFrame

 End Sub

保存宏后，通过按“F8”键单步运行宏，或者点击菜单中的“运行”按钮都可以运行宏。不必每次运行宏时都单步执行代码。依次单击菜单“工具”>>“宏”>>“宏”，选择一个宏，然后单击“运行”。从中望CAD 中运行该宏，进行相应的操作后。(可以打开有单行文字的DWG文件，或者在平台上画几个单行文字)执行后的结果如下图所示：


VBA 移植指南

本章内容包括：

  • 移植要点及步骤
  • 使用对象浏览器查看接口


移植要点及步骤

VBA 程序的移植，需要注意平台所提供的 VBA 接口差异及兼容性，在移植的时候，也需要注意一些移植的要点。

本节包含如下内容：

  • ACAD 与中望CAD 平台所提供的 VBA 接口差异及兼容性
  • VBA 程序移植要点及步骤的介绍


ACAD 与中望CAD 平台所提供的 VBA 接口差异及兼容性

关键字的差异

  1. 所有对象类型

    ACAD 是使用 Acad 为开头，中望CAD 使用 Zcad 为开头。

    • 线对象 AcadLine ZcadLine

    • 圆对象 AcadCircle ZcadCircle

    • 多段线 AcadPolyline ZcadPolyline

  2. 枚举对象

    枚举对象 ACAD 大多以 Ac 为开头，中望CAD 则是以 Zc 为开头。比如：线宽 Aclineweight Zclineweight。

兼容性

从对象模型看中望CAD 和 ACAD 是比较类似，所以兼容性还是比较好的。主要差异就是对象的名称差异，以及暂时缺少部分接口。VBA 程序设计的流程和算法是兼容的。


VBA 程序移植要点及步骤的介绍

如何将 ACAD 的程序移植到中望CAD

具体流程如下：

  1. 将 Thisdrawing 中的所有代码从 AutoCAD 复制到中望CAD。

    2. 注：对于 VBA 程序中的类（Class）、窗体（Form）和模块（Module）可以直接从 AutoCAD 中导出，再在中望CAD 中导入。

  2. 将对象类型从 AcadXXX 改为 ZcadXXX, 比如, AcadLayer→ZcadLayer, IAcadLWPolyline→IZcadLWPolyline。

  3. 将颜色对象类型从 AcadAcCmColor 改为 ZcadZcCmColor。

  4. 将枚举或宏名从 acXXX 改为 zcXXX, 比如 acRed→zcRed。 但是对象名字中的 AC 或 ACAD 无需修改，比如 AcDbLine 等。

  5. 目前还不支持 preference。

  6. AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")→ZcadApplication.GetInterfaceObject("ZWCAD.ZcCmColor ")。

有关于移植接口中的不同

可以在使用中需要 ，经常查询对象浏览器(Object Browser) ，点击文档右键就可以看见“对象浏览器(Object Browser)”(F2)或者在视图（view）中也可以看到，查看对象浏览器，主要是查看中望CAD 对象的参数类型、返回值类型 。具体可以看“使用对象浏览器查看接口”。

如何将旧版本中望CAD 的程序移植到中望CAD

具体流程如下：

  1. 将 Thisdocument 中的所有代码从 旧版本中望CAD 复制到中望CAD。

    2. 注：对于 VBA 程序中的类（Class）、窗体（Form）和模块（Module）可以直接从 旧版本中望CAD 中导出，再在中望CAD 中导入。

  2. 将 Thisdocument 改为 Thisdrawing。

  3. 将对象类型从 ZwcadXXX 改为 ZcadXXX, 比如, ZwcadLayer→ZcadLayer, IZwcadLWPolyline→IZcadLWPolyline。

  4. 不再支持的属性：

    • ZVector

    • Parent

  5. 不再支持的方法：

    • ListSDS

    • LoadLISP

    • LoadSdS

    • UnLoadSDS

    • Justification

    • WildCardMatch

    • PaintLine

    • RunCommand

    • SaveAll

  6. 使用方法有改动的属性和方法：

    • Thisdrawing.regen 要带参数运行。

    • PlotToDevice 要带参数运行。

    • ThisDrawing.ActiveViewport.ZoomAll 要改为 ZoomAll。

    • getattributes 的返回值是数组，要用类似 var(0) 的方式取值，不能用 var.item(0)。

    • 类似这样的代码
      Dim color As ZwcadAcCmColor
      Set color = Library.CreateTrueColor
      要改成
      Dim color As ZcadZcCmColor
      Set color = ZcadApplication.GetInterfaceObject("ZWCAD.ZcCmColor")

    • 类似这样的代码
      Dim patterntype As zcHatchType
      要改成
      Dim patterntype As Long


使用对象浏览器查看接口

由于中望CAD 同 ACAD 的 VBA 接口，存在一定的差别，这就需要我们要对程序进行移植。

为了使我们可以知道中望CAD 与 ACAD 接口之间的区别，可以使用 VBA 编辑中提供的“对象浏览器”，查看接口的方法的说明等。

  1. 在VBA编辑器中，按快捷键F2或者按右键->选择“对象浏览器”，便可以出现对象浏览器的界面如下：

  2. 如上图所示。我们在里面查找 AddLine 函数的用法，便可以在最下端看到这个函数的参数说明等。了解AddLine的第一个参数为 VarStarPoint，第二个参数为 VarEndPoint。

PS：有关具体的移植可以参考本指南的其它部分内容。总之这个浏览器在我们的 VBA 编程时比较有用，在移植 VBA 程序时更是如此。


中望CAD 与 ACAD 的 Active 函数差异列表

差异列表如下：

AutoCAD Active 函数 | 中望CAD Active 函数
(ModelSpace, PaperSpace,Block)Function Add3DFace(Point1, Point2,point3, Point4) As Acad3DFace | (ModelSpace, PaperSpace,Block)Function Add3DFace(Point1 As ZwcadPoint, Point2 As ZwcadPoint, Point3 As ZwcadPoint, [Point4 As ZwcadPoint]) As Zwcad3DFace
(ModelSpace, PaperSpace,Block)(ModelSpace, PaperSpace,Block) Function Add3DMesh(M As Long, N As Long, PointsMatrix) As AcadPolygonMesh | (ModelSpace, PaperSpace,Block)Function Add3DMesh(M As Long, N As Long, Vertices As ZwcadPoints) As ZwcadPolygonMesh
(ModelSpace, PaperSpace,Block)Function Add3DPoly(PointsArray) As Acad3DPolyline | (ModelSpace, PaperSpace,Block)Function Add3DPoly(Vertices As ZwcadPoints) As Zwcad3DPolyline
(ModelSpace, PaperSpace,Block)Function AddArc(Center, Radius As Double, StartAngle As Double, EndAngle As Double) As AcadArc | (ModelSpace, PaperSpace,Block)Function AddArc(Center As ZwcadPoint, Radius As Double, StartAngle As Double, EndAngle As Double) As ZwcadArc
(ModelSpace, PaperSpace,Block)Function AddAttribute(Height As Double, Mode As AcAttributeMode, Prompt As String, InsertionPoint, Tag As String, Value As String) As AcadAttribute | (ModelSpace, PaperSpace,Block)Function AddAttribute(Height As Double, Mode As ZcAttributeMode, Prompt As String, InsertionPoint As ZwcadPoint, Tag As String, Value As String) As ZwcadAttribute
(ModelSpace, PaperSpace,Block)Function AddBox(Origin, Length As Double, Width As Double, Height As Double) As Acad3DSolid | (ModelSpace, PaperSpace,Block)Function AddBox(Origin As ZwcadPoint, Length As Double, Width As Double, Height As Double) As ZwcadPolygonMesh
(ModelSpace, PaperSpace,Block)Function AddCircle(Center, Radius As Double) As AcadCircle | (ModelSpace, PaperSpace,Block)Function AddCircle(Center As ZwcadPoint, Radius As Double) As ZwcadCircle
(ModelSpace, PaperSpace,Block)Function AddCone(Center, BaseRadius As Double, Height As Double) As Acad3DSolid | (ModelSpace, PaperSpace,Block)Function AddCone(Center As ZwcadPoint, BaseRadius As Double, Height As Double) As ZwcadPolygonMesh
(ModelSpace, PaperSpace,Block)Function AddCylinder(Center, Radius As Double, Height As Double) As Acad3DSolid | (ModelSpace, PaperSpace,Block)Function AddCylinder(Center As ZwcadPoint, Radius As Double, Height As Double) As ZwcadPolygonMesh
(ModelSpace, PaperSpace,Block)Function AddDim3PointAngular(AngleVertex, FirstEndPoint, SecondEndPoint, TextPoint) As AcadDim3PointAngular | (ModelSpace, PaperSpace,Block)Function AddDim3PointAngular(AngleVertex As ZwcadPoint, FirstEndPoint As ZwcadPoint, SecondEndPoint As ZwcadPoint, TextLocation As ZwcadPoint) As ZwcadDim3PointAngular
(ModelSpace, PaperSpace,Block)Function AddDimAligned(ExtLine1Point, ExtLine2Point, TextPosition) As AcadDimAligned | (ModelSpace, PaperSpace,Block)Function AddDimAligned(ExtPoint1 As ZwcadPoint, ExtPoint2 As ZwcadPoint, TextLocation As ZwcadPoint) As ZwcadDimAligned
(ModelSpace, PaperSpace,Block)Function AddDimAngular(AngleVertex, FirstEndPoint, SecondEndPoint, TextPoint) As AcadDimAngular | (ModelSpace, PaperSpace,Block)Function AddDimAngular(AngleVertex As ZwcadPoint, FirstEndPoint As ZwcadPoint, SecondEndPoint As ZwcadPoint, TextLocation As ZwcadPoint) As ZwcadDimAngular
(ModelSpace, PaperSpace,Block)Function AddDimDiametric(ChordPoint, FarChordPoint, LeaderLength As Double) As AcadDimDiametric | (ModelSpace, PaperSpace,Block)Function AddDimDiametric(ChordPoint As ZwcadPoint, FarChordPoint As ZwcadPoint, LeaderLength As Double) As ZwcadDimDiametric
(ModelSpace, PaperSpace,Block)Function AddDimOrdinate(DefinitionPoint, LeaderEndPoint, UseXAxis As Long) As AcadDimOrdinate | (ModelSpace, PaperSpace,Block)Function AddDimOrdinate(DefintionPoint As ZwcadPoint, LeaderEndPoint As ZwcadPoint, UseXAxis As Boolean) As ZwcadDimOrdinate
(ModelSpace, PaperSpace,Block)Function AddDimRadial(Center, ChordPoint, LeaderLength As Double) As AcadDimRadial | (ModelSpace, PaperSpace,Block)Function AddDimRadial(Center As ZwcadPoint, ChordPoint As ZwcadPoint, LeaderLength As Double) As ZwcadDimRadial
(ModelSpace, PaperSpace,Block)Function AddDimRotated(ExtLine1Point, ExtLine2Point, DimLineLocation, RotationAngle As Double) As AcadDimRotated | (ModelSpace, PaperSpace,Block)Function AddDimRotated(ExtPoint1 As ZwcadPoint, ExtPoint2 As ZwcadPoint, DimLineLocation As ZwcadPoint, Rotation As Double) As ZwcadDimRotated
Function AddEllipse(Center, MajorAxis, RadiusRatio As Double) As AcadEllipse | Function AddEllipse(Center As ZwcadPoint, MajorAxis As ZwcadVector, RadiusRatio As Double) As ZwcadEllipse
(ModelSpace, PaperSpace,Block)Function AddLeader(PointsArray, Annotation As AcadEntity, Type As AcLeaderType) As AcadLeader | (ModelSpace, PaperSpace,Block)Function AddLeader(Points As ZwcadPoints, [Annotation As ZwcadEntity], [Type As ZcLeaderType = zcLineNoArrow]) As ZwcadLeader
(ModelSpace, PaperSpace,Block)Function AddLightWeightPolyline(VerticesList) As AcadLWPolyline | (ModelSpace, PaperSpace,Block)Function AddLightWeightPolyline(Vertices As ZwcadPoints) As ZwcadLWPolyline
(ModelSpace, PaperSpace,Block)Function AddLine(StartPoint, EndPoint) As AcadLine | (ModelSpace, PaperSpace,Block)Function AddLine(StartPoint As ZwcadPoint, EndPoint As ZwcadPoint) As ZwcadLine
(ModelSpace, PaperSpace,Block)Function AddMLine(VertexList) As AcadMLine | (ModelSpace, PaperSpace,Block)Function AddMLine(Vertices As ZwcadPoints) As ZwcadMLine
(ModelSpace, PaperSpace,Block)Function AddPoint(Point) As AcadPoint | (ModelSpace, PaperSpace,Block)Function AddPointEntity(Point As ZwcadPoint) As ZwcadPointEntity
(ModelSpace, PaperSpace,Block)Function AddPolyfaceMesh(VertexList, FaceList) As AcadPolyfaceMesh | (ModelSpace, PaperSpace,Block)Function AddPolyfaceMesh(Vertices As ZwcadPoints, ListOfFaceIndices) As ZwcadPolyfaceMesh
(ModelSpace, PaperSpace,Block)Function AddPolyline(VerticesList) As AcadPolyline | (ModelSpace, PaperSpace,Block) Function AddPolyline(Vertices As ZwcadPoints) As ZwcadPolyline
(ModelSpace, PaperSpace,Block)Function AddRaster(imageFileName As String, InsertionPoint, ScaleFactor As Double, RotationAngle As Double) As AcadRasterImage | (ModelSpace, PaperSpace,Block)Function AddRaster(ImageFile As String, InsertionPoint As ZwcadPoint, [ScaleFactor As Double = 1], [RotationAngle As Double]) As ZwcadRasterImage
(ModelSpace, PaperSpace,Block)Function AddRay(Point1, Point2) As AcadRay | (ModelSpace, PaperSpace,Block)Function AddRay(Point1 As ZwcadPoint, Point2 As ZwcadPoint) As ZwcadRay
(ModelSpace, PaperSpace,Block)Function AddShape(Name As String, InsertionPoint, ScaleFactor As Double, RotationAngle As Double) As AcadShape | (ModelSpace, PaperSpace,Block)Function AddShape(Name As String, InsertionPoint As ZwcadPoint, [Height As Double = 1], [Rotation As Double]) As ZwcadShape
(ModelSpace, PaperSpace,Block)Function AddSolid(Point1, Point2, point3, Point4) As AcadSolid | (ModelSpace, PaperSpace,Block)Function AddSolid(Point1 As ZwcadPoint, Point2 As ZwcadPoint, Point3 As ZwcadPoint, [Point4 As ZwcadPoint]) As ZwcadSolid
(ModelSpace, PaperSpace,Block)Function AddSphere(Center, Radius As Double) As Acad3DSolid | (ModelSpace, PaperSpace,Block)Function AddSphere(Center As ZwcadPoint, Radius As Double) As ZwcadPolygonMesh
(ModelSpace, PaperSpace,Block)Function AddSpline(PointsArray, StartTangent, EndTangent) As AcadSpline | (ModelSpace, PaperSpace,Block)Function AddSpline(Points As ZwcadPoints, StartTangent As ZwcadVector, EndTangent As ZwcadVector) As ZwcadSpline
(ModelSpace, PaperSpace,Block) Function AddText(TextString As String, InsertionPoint, Height As Double) As AcadText | (ModelSpace, PaperSpace,Block) Function AddText(TextString As String, InsertionPoint As ZwcadPoint, Height As Double) As ZwcadText
(ModelSpace, PaperSpace,Block) Function AddTolerance(Text As String, InsertionPoint, Direction) As AcadTolerance | (ModelSpace, PaperSpace,Block) Function AddTolerance(Text As String, InsertionPoint As ZwcadPoint, Direction As ZwcadVector) As ZwcadTolerance
(ModelSpace, PaperSpace,Block) Function AddTorus(Center, TorusRadius As Double, TubeRadius As Double) As Acad3DSolid | (ModelSpace, PaperSpace,Block) Function AddTorus(Center As ZwcadPoint, TorusRadius As Double, TubeRadius As Double) As ZwcadPolygonMesh
(ModelSpace, PaperSpace,Block) Function AddTrace(PointsArray) As AcadTrace | (ModelSpace, PaperSpace,Block) Function AddTrace(Points As ZwcadPoints) As ZwcadTrace
(ModelSpace, PaperSpace,Block) Function AddWedge(Center, Length As Double, Width As Double, Height As Double) As Acad3DSolid | (ModelSpace, PaperSpace,Block) Function AddWedge(Origin As ZwcadPoint, Length As Double, Width As Double, Height As Double) As ZwcadPolygonMesh
(ModelSpace, PaperSpace,Block) Function AddXline(Point1, Point2) As AcadXline | (ModelSpace, PaperSpace,Block) Function AddXline(Point1 As ZwcadPoint, Point2 As ZwcadPoint) As ZwcadXline
(ModelSpace, PaperSpace,Block) Function AttachExternalReference(PathName As String, Name As String, InsertionPoint, Xscale As Double, Yscale As Double, Zscale As Double, Rotation As Double, bOverlay As Boolean, [Password]) As AcadExternalReference | (ModelSpace, PaperSpace,Block) Function AttachExternalReference(PathName As String, Name As String, InsertionPoint As ZwcadPoint, [XScale As Double = 1], [YScale As Double = 1], [ZScale As Double = 1], [Rotation As Double], [bOverlay As Boolean = False]) As ZwcadExternalReference
(PaperSpace) Function AddPViewport(Center, Width As Double, Height As Double) As AcadPViewport | (PaperSpace) Function AddPViewport([Center As ZwcadPoint], [Width As Double], [Height As Double]) As ZwcadPViewport
(Dimension相关对象) Property TextPosition As Variant | (Dimension相关对象) Property TextPosition As ZwcadPoint
(Dim3PointAngular, DimAngular) Property ExtLine1EndPoint As Variant | (Dim3PointAngular, DimAngular) Property ExtLine1EndPoint As ZwcadPoint
(Dim3PointAngular, DimAngular) Property ExtLine1StartPoint As Variant | (Dim3PointAngular, DimAngular) Property ExtLine1StartPoint As ZwcadPoint
(Dim3PointAngular, DimAngular) Property ExtLine2EndPoint As Variant | (Dim3PointAngular, DimAngular) Property ExtLine2EndPoint As ZwcadPoint
(Dim3PointAngular, DimAngular) Property ExtLine2StartPoint As Variant | (Dim3PointAngular, DimAngular) Property ExtLine2StartPoint As ZwcadPoint
(DimAligned) Property ExtLine1Point As Variant | (DimAligned) Property ExtLine1Point As ZwcadPoint
(DimAligned) Property ExtLine2Point As Variant | (DimAligned) Property ExtLine2Point As ZwcadPoint
(Dim3PointAngular) Property AngleVertex As Variant | (Dim3PointAngular) Property AngleVertex As ZwcadPoint
(Entity) Property Normal As Variant | (Entity) Property Normal As ZwcadVector
(Document) Property Limits As Variant | (Document) Property Limits As ZwcadPoints
(Document) Function Import(FileName As String, InsertionPoint, ScaleFactor As Double) As Object | (Document) Sub Import(FileName As String, [InsertionPoint As ZwcadPoint], [ScaleFactor As Double = 1])
(Document) Sub Wblock(FileName As String, SelectionSet As AcadSelectionSet) | (Document) Sub WBlock(FileName As String, SelectionSet As ZwcadSelectionSet, [Origin As ZwcadPoint])
(Entity) Function ArrayPolar(NumberOfObjects As Long, AngleToFill As Double, CenterPoint) | (Entity) Function ArrayPolar(NumberOfObjects As Long, IncludedAngle As Double, CenterPoint As ZwcadPoint, PointOnAxis As ZwcadPoint, [RotateObjects As Boolean = True]) As ZwcadSelectionSet
(Entity) Sub GetBoundingBox(MinPoint, MaxPoint) | (Entity) Sub GetBoundingBox(MinPoint As ZwcadPoint, MaxPoint As ZwcadPoint)
(Entity) Function IntersectWith(IntersectObject As Object, option As AcExtendOption) | (Entity) Function IntersectWith(IntersectingObject As Object, Option As ZcIntersectOptions) As ZwcadPoints
(Entity) Function Mirror(Point1, Point2) As Object | (Entity) Function Mirror(Point1 As ZwcadPoint, Point2 As ZwcadPoint, [MakeCopy As Boolean = True]) As ZwcadEntity
(Entity) Function Mirror3D(Point1, Point2, point3) As Object | (Entity) Function Mirror3D(Point1 As ZwcadPoint, Point2 As ZwcadPoint, Point3 As ZwcadPoint, [MakeCopy As Boolean = True]) As ZwcadEntity
(Entity) Sub Move(FromPoint, ToPoint) | Sub Move(Point1 As ZwcadPoint, Point2 As ZwcadPoint)
(Entity) Sub Rotate(BasePoint, RotationAngle As Double) | (Entity) Sub Rotate(BasePoint As ZwcadPoint, RotationAngle As Double)
(Entity) Sub Rotate3D(Point1, Point2, RotationAngle As Double) | (Entity) Sub Rotate3D(Point1 As ZwcadPoint, Point2 As ZwcadPoint, RotationAngle As Double)
(Entity) Sub ScaleEntity(BasePoint, ScaleFactor As Double) | (Entity) Sub ScaleEntity(BasePoint As ZwcadPoint, ScaleFactor As Double)
(Entity) Sub TransformBy(TransformationMatrix) | (Entity) Sub TransformBy(Matrix As ZwcadMatrix)
(Entity) Property Coordinate(Index As Long) | (Entity) Property Coordinate(Index As Long) As ZwcadPoint
(Entity) Property Coordinates As Variant | (Entity) Property Coordinates As ZwcadPoints
(3DPolyline, PolygonMesh,Polyline) Sub AppendVertex(vertex) | (3DPolyline, PolygonMesh,Polyline) Sub AppendVertex(Vertex As ZwcadPoint)
(Entity) Property Center As Variant | (Entity) Property Center As ZwcadPoint
(Arc, Ellipse, Line) Property EndPoint As Varian | (Arc, Ellipse, Line) Property EndPoint As ZwcadPoint
(Arc, Ellipse, Line) Property StartPoint As Variant | (Arc, Ellipse, Line) Property StartPoint As ZwcadPoint
(Entity) Property InsertionPoint As Variant | (Entity) Property InsertionPoint As ZwcadPoint
(Attribute, AttributeReference, Text) Property TextAlignmentPoint As Variant | (Attribute, AttributeReference, Text) Property TextAlignmentPoint As ZwcadPoint
(LWPolyline) Sub AddVertex(Index As Long, vertex) | (LWPolyline) Sub AddVertex(Index As Long, Point As ZwcadPoint)
(PViewport, Viewport) Property SnapBasePoint As Variant | (PViewport, Viewport) Property SnapBasePoint As ZwcadPoint
(PViewport, View,Viewport) Property Target As Variant | (PViewport, View,Viewport) Property Target As ZwcadPoint
(Application) Sub ZoomCenter(Center, Magnify As Double) | (Application) Sub ZoomCenter(Center As ZwcadPoint, ZoomFactor As Double)
(Application) Sub ZoomWindow(LowerLeft, UpperRight) | (Application) Sub ZoomCenter(Center As ZwcadPoint, ZoomFactor As Double)
(Block, UCS, RasterImage) Property Origin As Variant | (Block, UCS, RasterImage) Property Origin As ZwcadPoint
(RasterImage) Sub ClipBoundary(boundry) | (RasterImage) Sub ClipBoundary(Boundary As ZwcadPoints)
(Ray, Xline) Property SecondPoint As Variant | (Ray, Xline) Sub ClipBoundary(boundry)
(Spline) Property ControlPoints As Variant | (Spline) Property ControlPoints As ZwcadPoints
(Spline) Property FitPoints As Variant | (Spline) Property FitPoints As ZwcadPoints
(Spline) Sub AddFitPoint(Index As Long, fitPoint) | (Spline) Sub AddFitPoint(Index As Long, FitPoint As ZwcadPoint)
(Spline) Function GetControlPoint(Index As Long) | (Spline) Function GetControlPoint(Index As Long) As ZwcadPoint
(Spline) Function GetFitPoint(Index As Long) | Function GetFitPoint(Index As Long) As ZwcadPoint
(Spline) Sub SetFitPoint(Index As Long, fitPoint) | (Spline) Sub SetFitPoint(Index As Long, FitPoint As ZwcadPoint)
(Spline) Sub SetControlPoint(Index As Long, controlPoint) | (Spline) Sub SetControlPoint(Index As Long, ControlPoint As ZwcadPoint)
(Region) Property Centroid As Variant | (Region) Property Centroid As ZwcadPoint
(Region) Property MomentOfInertia As Variant | (Region) Property MomentOfInertia As ZwcadPoint
(Region) Property Normal As Variant | (Region) Property Normal As ZwcadPoint
(Region) Property PrincipalDirections As Variant | (Region) Property PrincipalDirections As ZwcadPoints
(Region) Property PrincipalMoments As Variant | (Region) Property PrincipalMoments As ZwcadPoint
(Region) Property RadiiOfGyration As Variant | (Region) Property RadiiOfGyration As ZwcadPoint
(Ellipse) Property MajorAxis As Variant | (Ellipse) Property MajorAxis As ZwcadVector
(Ellipse) Property MinorAxis As Variant | (Ellipse) Property MinorAxis As ZwcadVector
(Entity) Property Direction As Variant | (Entity) Property Direction As ZwcadVector
(Ray, Tolerance, XLine) Property DirectionVector As Variant | (Ray, Tolerance, XLine) Property DirectionVector As ZwcadVector
(Spline) Property EndTangent As Variant | (Spline) Property EndTangent As ZwcadVector
(Spline) Property StartTangent As Variant | (Spline) Property StartTangent As ZwcadVector
(PlotConfiguration,Layout) Property PlotOrigin As Variant | (PlotConfiguration,Layout) Property PlotOrigin As ZwcadPoint
(PlotConfiguration,Layout) Sub GetWindowToPlot(LowerLeft As Variant, UpperRight As Variant) | (PlotConfiguration,Layout) Sub GetWindowToPlot(ppLowerLeft As ZwcadPoint, ppUpperRight As ZwcadPoint)
(PlotConfiguration,Layout) Sub SetWindowToPlot(LowerLeft As Variant, UpperRight As As Variant) | (PlotConfiguration,Layout) Sub SetWindowToPlot(pLowerLeft As ZwcadPoint, pUpperRight As ZwcadPoint)
(PlotConfiguration,Layout) Sub GetPaperMargins(LowerLeft, UpperRight) | (PlotConfiguration,Layout) Sub GetPaperMargins(ppLowerLeft As ZwcadPoint, ppUpperRight As ZwcadPoint)
(Utility) Function AngleFromXAxis(StartPoint, EndPoint) As Double | (Utility) Function AngleFromXAxis(Point1 As ZwcadPoint, Point2 As ZwcadPoint) As Double
(Utility) Function GetAngle([Point], [Prompt]) As Double | (Utility) Function GetAngle([Point As ZwcadPoint], [Prompt As String]) As Double
(Utility) Function GetCorner(Point, [Prompt]) As Variant | (Utility) Function GetCorner(Point As ZwcadPoint, [Prompt As String]) As ZwcadPoint
(Utility) Function GetDistance([Point], [Prompt]) As Double | (Utility) Function GetDistance([Point As ZwcadPoint], [Prompt As String]) As Double
(Utility) Sub GetEntity(Object As Object, PickedPoint, [Prompt]) | (Utility) Sub GetEntity(Object As Object, PickedPoint As ZwcadPoint, [Prompt As String])
(Utility) Sub GetSubEntity(Object As Object, PickedPoint, transMatrix, ContextData, [Prompt]) | (Utility) Sub GetSubEntity(Object As Object, PickedPoint As ZwcadPoint, TransMatrix As ZwcadMatrix, ContextData, [Prompt As String])
(Utility) Function GetOrientation([Point], [Prompt]) As Double | (Utility) Function GetOrientation([Point As ZwcadPoint], [Prompt As String]) As Double
(Utility) Function GetPoint([Point], [Prompt]) as Variant | (Utility) Function GetPoint([Point As ZwcadPoint], [Prompt As String]) As ZwcadPoint
(Utility) Function TranslateCoordinates(Point, FromCoordSystem As AcCoordinateSystem, ToCoordSystem As AcCoordinateSystem, Displacement As Long, [OCSNormal]) | (Utility) Function TranslateCoordinates(OriginPoint As ZwcadPoint, From As ZcCoordinateSystemTypes, To As ZcCoordinateSystemTypes, Disp As Boolean) As ZwcadPoint
(Utility) Function PolarPoint(Point, Angle As Double, Distance As Double) as Variant | (Utility) Function PolarPoint(Point As ZwcadPoint, Angle As Double, Distance As Double) As ZwcadPoint
(Blocks) Function Add(InsertionPoint, Name As String) As AcadBlock | (Blocks) Function Add(InsertionPoint As ZwcadPoint, Name As String) As ZwcadBlock
(UCSs) Function Add(Origin, XAxisPoint, YAxisPoint, Name As String) As AcadUCS | (UCSs) Function Add(Origin As ZwcadPoint, XAxis As ZwcadPoint, YAxis As ZwcadPoint, Name As String) As ZwcadUCS
(Viewport) Property LowerLeftCorner As Variant | (Viewport) Property LowerLeftCorner As ZwcadPoint
(Viewport) Property UpperRightCorner As Variant | (Viewport) Property UpperRightCorner As ZwcadPoint
(SelectionSet) Sub Select(Mode As AcSelect, [Point1], [Point2], [FilterType], [FilterData]) | (SelectionSet) Sub Select(Type As ZcSelectionSetType, [Point1 As ZwcadPoint], [Point2 As ZwcadPoint], [FilterType], [FilterData])
(SelectionSet) Sub SelectAtPoint(Point, [FilterType], [FilterData]) | (SelectionSet) Sub SelectAtPoint(Point As ZwcadPoint, [FilterType], [FilterData])
(SelectionSet) Sub SelectByPolygon(Mode As AcSelect, PointsList, [FilterType], [FilterData]) | (SelectionSet) Sub SelectByPolygon(Type As ZcSelectionSetType, PolygonPoints As ZwcadPoints, [FilterType], [FilterData])
(UCS) Function GetUCSMatrix() as Variant | (UCS) Function GetUCSMatrix() As ZwcadMatrix
(UCS) Property XVector As Variant | (UCS) Property XVector As ZwcadVector
(UCS) Property YVector As Variant | (UCS) Property YVector As ZwcadVector
(UCS) Property ZVector As Variant | (UCS) Property ZVector As ZwcadVector
(3dSolid) Function Explode() As Variant | Function Explode() As ZwcadSelectionSet
(Entity) Function Offset(Distance As Double) As Variant | (Entity) Function Offset(Offset As Double) As ZwcadSelectionSet
(Entity) Sub TransformBy(TransformationMatrix) As Double | (Entity) Sub TransformBy(Matrix As ZwcadMatrix)


ZWCAD 对象模型

中望CAD 对象模型

对象就是中望CAD ActiveX接口的主要构件，每一个显示的对象又代表一个中望CAD 组件。中望CAD ActiveX 接口中有许多不同类型的对象。如下，直线、文字样式、图层、视图、中望CAD 应用程序都是对象。对象按照分层结构来组织，其根是 Application 对象。这种层次结构的视图称为“对象模型”。对象模型给出了上级对象与下级对象之间的访问关系。

通过Application对象，用户可以访问其他任何对象或者任何对象指定的属性或方法。Document对象可以在Documents集合中找到，通过它可以访问所有图形和大部分非图形中望CAD 对象。通过ModelSpace和PaperSpace集合可以访问图形对象（点、直线、圆等），也能访问非图形对象（图层、线型、文字样式等）。通过Document对象还可以访问Plot和Utility对象。

通过组、块、选择集的形式可以把中望CAD 大部分对象组成集合。虽然这些集合包含了不同类型的数据，但是可以使用相似的方法来处理它们。用户可以通过Add、AddItems、AppendItems方法向集合中添加对象。但是添加图元对象通常使用Add（Entityname）的方式来添加，例如，要添加圆，可以使用AddCirlce方法。集合还有一些其他的常用方法和属性，Count特性用于获取集合中的对象个数。Item方法可以获取集合中的任意对象。