环境与引用步骤同: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 后,现有点的外观将在下次重新生成图形时改变。