VB中能调用CAD自动画图么
2017-05-02
展开全部
On Error Resume Next
Set myAcadApp = GetObject(, "Autocad.Application") '检查AutoCAD是否已经打开
If Err <> 0 Then '没有打开
Err.Clear
Set myAcadApp = CreateObject("Autocad.Application") '打开CAD
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
Set myAcadApp = GetObject(, "Autocad.Application") '检查AutoCAD是否已经打开
If Err <> 0 Then '没有打开
Err.Clear
Set myAcadApp = CreateObject("Autocad.Application") '打开CAD
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
天正软件
2024-08-02 广告
2024-08-02 广告
天正软件可以解决以下问题:1. 提供设计标准化:天正软件专注于勘察设计领域,为用户提供标准化、信息化、智能化的解决方案,以提高设计效率、优化设计流程、降低成本。2. 提高绘图效率:天正软件提供了一系列专业绘图工具,能够帮助设计师快速绘制图纸...
点击进入详情页
本回答由天正软件提供
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询