|
|
Dim acadapp As AcadApplication
Dim AcadDoc As AcadDocument
Dim obj_Acad As Object, obj_Doc As Object, obj_ModelSpace As Object
Private Sub Command3_Click()
On Error Resume Next '如果目前系统中已执行，则取得已执行autocad物件
Set acadapp = GetObject(, "AutoCAD.Application.17") '检查AutoCAD是否已经打开
If Err Then '没有打开
Err.Clear '如果目前系统中尚未执行autocad，则建立autocad物件
Set acadapp = CreateObject("AutoCAD.Application.17") '打开CAD
If Err Then
MsgBox "连接错误" '打开失败显示连接错误
End If
End If
On Error GoTo 0 '这行是增加的：取消错误陷阱。没有这一行，调试时你后面程序中的错误无法发现
acadapp.Visible = True '显示CAD
Set AcadDoc = acadapp.ActiveDocument '使用acaddoc变量引用当前的AutoCAD图形
Dim HatchObj1 As AcadHatch '定义HatchObj1为CAD里面填充对象
Dim Ld1(0 To 0) As AcadEntity '定义outerLoop为CAD里面的实体
Dim syu(0 To 7) As Double '画矩形不需要5个顶点
syu(0) = 0: syu(1) = 0
syu(2) = 800: syu(3) = 0
syu(4) = 800: syu(5) = 200
syu(6) = 0: syu(7) = 200
Set Ld1(0) = AcadDoc.ModelSpace.AddLightWeightPolyline(syu)
AcadDoc.Regen True
End Sub
|
|
置顶卡
