AutoCAD二次开发教程（3）-通过VB6绘制点并设置样式

环境与引用步骤同：AutoCAD二次开发教程（1）-通过VB6绘制直线

1：绘制点

代码如下：

On Error Resume Next
' 连接至 AutoCAD 应用程序
Dim acadApp As AcadApplication
Dim docObj As AcadDocument
Set acadApp = GetObject(, "AutoCAD.Application.17.1")
Set docObj = acadApp.Application.Documents.Add
If Err Then
    Err.Clear
    Set acadApp = CreateObject("AutoCAD.Application.17.1")
    Set docObj = acadApp.Application.Documents.Add
    If Err Then
        MsgBox ("无法运行AutoCAD2008，请检查是否安装了AutoCAD2008")
        Exit Sub
    End If
End If

' 连接至 AutoCAD 图形
Dim acadDoc As AcadDocument
Set acadDoc = acadApp.ActiveDocument
acadApp.Visible = True

' 绘制点   
Dim pointObj As AcadPoint
Dim location(0 To 2) As Double

' 定义点的位置
location(0) = 5
location(1) = 5
location(2) = 0

' 创建点
Set pointObj = acadDoc.ModelSpace.AddPoint(location)
   
acadDoc.Application.ZoomAll

运行后的效果如下，没有设置样式所以有点看不太清楚。

2：设置样式

代码如下：

On Error Resume Next
' 连接至 AutoCAD 应用程序
Dim acadApp As AcadApplication
Dim docObj As AcadDocument
Set acadApp = GetObject(, "AutoCAD.Application.17.1")
Set docObj = acadApp.Application.Documents.Add
If Err Then
    Err.Clear
    Set acadApp = CreateObject("AutoCAD.Application.17.1")
    Set docObj = acadApp.Application.Documents.Add
    If Err Then
        MsgBox ("无法运行AutoCAD2008，请检查是否安装了AutoCAD2008")
        Exit Sub
    End If
End If

' 连接至 AutoCAD 图形
Dim acadDoc As AcadDocument
Set acadDoc = acadApp.ActiveDocument
acadApp.Visible = True

' 绘制点   
Dim pointObj As AcadPoint
Dim location(0 To 2) As Double

' 定义点的位置
location(0) = 5
location(1) = 5
location(2) = 0

' 创建点
Set pointObj = acadDoc.ModelSpace.AddPoint(location)
' 设置点的样式
acadDoc.SetVariable "PDMODE", 34
acadDoc.SetVariable "PDSIZE", 1
   
acadDoc.Application.ZoomAll

效果如下：

PDSIZE 控制点图形的尺寸（PDMODE 值为 0 和 1 时除外）。如果设置为 0，则点图形的高度是图形区高度的 5%。正的 PDSIZE 值指定点图形的绝对尺寸。负值将解释为视口大小的百分比。重生成图形时将重新计算所有点的大小。

更改 PDMODE 和 PDSIZE 后，现有点的外观将在下次重新生成图形时改变。