|
|
Private Sub Command1_Click()
Dim Pt1(0 To 2) As Double
Dim Pt2(0 To 2) As Double
On Error Resume Next
' 连接至 应用程序
Dim acadApp As AcadApplication
Set acadApp = GetObject(, "AutoCAD.Application.16")
If Err Then
Err.Clear
Set acadApp = CreateObject("AutoCAD.Application.16")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
' 连接至 AutoCAD 图形
Dim acadDoc As AcadDocument
Set acadDoc = acadApp.ActiveDocument
Dim ptpick5 As Variant
Dim ptpick6 As Variant
ptpick5 = acadDoc.ModelSpace.Utility.GetPoint(, "请拾取第一点吊点位置：")
ptpick6 = acadDoc.ModelSpace.Utility.GetPoint(, "请拾取第二点吊点位置：")
Pt1(0) = ptpick5(0)
Pt1(1) = ptpick5(1)
Pt1(2) = 0
Pt2(0) = ptpick6(0)
Pt2(1) = ptpick6(1)
Pt2(2) = 0
Set plineobj = acadDoc.ModelSpace.AddLine(Pt1, Pt2)
ZoomAll
acadApp.Visible = True
End Sub
以上代吗 不能和CAD进行交互，在VBA中可以，谁能帮忙在VB中实现同样的功能？谢谢 |
|
置顶卡
