'首先引用 acad ***Object Library類型庫,在工程菜單下面,引用勾選cad
Dim myAcadApp As AutoCAD.AcadApplication, activeDoc As AutoCAD.AcadDocument, acMS As AutoCAD.AcadModelSpace
On Error Resume Next
Set myAcadApp = GetObject(, "Autocad.Application") '檢查AutoCAD是否已經打開 Set myAcadApp = CreateObject("Autocad.Application") '打開CAD myAcadApp.Visible = True '顯示CAD
If Err <> 0 Then '沒有打開
Err.Clear
Set activeDoc = myAcadApp.ActiveDocument
If Err Then
MsgBox Err.Number & ":" & Err.Description '打開失敗
Exit Sub
End If
End If
On Error GoTo prcERR
myAcadApp.Visible = True '顯示CAD
Set activeDoc = myAcadApp.ActiveDocument
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
Dim LineObj As AcadLine'如果畫圖時出錯,改為Dim LineObj As Object
startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
endPoint(0) = 30: endPoint(1) = 20: endPoint(2) = 0
Set LineObj = activeDoc.ModelSpace.AddLine(startPoint, endPoint) '畫線
prcExit:
Set activeDoc = Nothing
Set myAcadApp = Nothing
Exit Sub
prcERR:
MsgBox Err.Number & ":" & Err.Description, vbCritical, "錯誤"
Resume prcExit
End Sub