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 后,现有点的外观将在下次重新生成图形时改变。

版权声明:
作者:胡伟明
链接:https://www.huweiming.cn/2022/11/976.html
来源:胡伟明
文章版权归作者所有,未经允许请勿转载。

THE END
分享
二维码
< <上一篇
下一篇>>
文章目录
关闭
目 录