Private Sub Command1_Click()
Dim Pt1(0 To 2) As Double Dim Pt2(0 To 2) As Double
On Error Resume Next ' 连接至 AutoCAD 应用程序 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中实现同样的功能?谢谢 |