VB程序如何编写成自动输出到CAD图形?方法...
答案:2 悬赏:0 手机版
解决时间 2021-01-24 23:18
- 提问者网友:凉末
- 2021-01-24 09:45
编写程序如画圆,画线其它图形,如何自动生成CAD处理图形文件.也就是说程序的参数改变后,图形也自动生,可以成自动链接状态.可以指导下编个简单例子,只要能输出成CAD图形就行.
最佳答案
- 五星知识达人网友:洒脱疯子
- 2021-01-24 10:52
Private Sub Command1_Click()
'首先引用 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
'首先引用 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
全部回答
- 1楼网友:往事隔山水
- 2021-01-24 12:22
先在 工程-引用 里面增加 aucocad类型库然后写代码如下:
private sub command1_click()
dim p1(2) as double, p2(2) as double, p3(2) as double
dim acad as acadapplication
dim adoc as acaddocument
dim aline as acadline
dim dima as acaddimaligned
set acad = createobject("autocad.application.16")
acad.visible = true
set adoc = acad.documents.add
p1(0) = 100: p1(1) = 100: p1(2) = 0
p2(0) = 1000: p2(1) = 1000: p2(2) = 0
p3(0) = 500: p3(1) = 520: p3(2) = 0
set aline = adoc.modelspace.addline(p1, p2)
aline.color = acblue
set dima = adoc.modelspace.adddimaligned(p1, p2, p3)
dima.textheight = 15
dima.textcolor = acgreen
dima.arrowheadsize = 10
end sub
我要举报
如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息,可以点下面链接进行举报!
点此我要举报以上问答信息
大家都在看
推荐资讯