AutoCAD利用VB交互创建应用程序交互
2011-06-06 21:21
323 查看
可以使用COM技术,在VB中直接操作AutoCAD,创建于VBA功能类似的程序,VB能够直接打包生成安装文件,这种形式比VBA更加方便,并且更容易保护自己的程序。VB连接到AutoCAD主要用到CreateObject和GetObject函数,创建或者获得对ActiveX对象的引用。
连接到AutoCAD之后,就可以使用acadApp对象对AutoCAD进行操作,语法和操作方法与VBA完全一致。
下面这段代码创建一个绘制楼梯剖面图的程序。
连接到AutoCAD之后,就可以使用acadApp对象对AutoCAD进行操作,语法和操作方法与VBA完全一致。
下面这段代码创建一个绘制楼梯剖面图的程序。
Dim bcal As Boolean
Dim ptarr1() As Double
Dim ptarr2(19) As Double
Private Sub cmdcal_Click()
Dim objcontrol As Control
For Each objcontrol In Form1.Controls
If TypeOf objcontrol Is TextBox Then
If objcontrol.Text = "" Then
MsgBox "缺少参数,无法计算!", vbCritical
Exit Sub
End If
End If
Next
Dim x0 As Double, y0 As Double
Dim s As Double, t As Double, n As Double
Dim b As Double, h As Double, h0 As Double
x0 = txtptx.Text: y0 = txtpty.Text
s = txtsteph.Text: t = txtstepw.Text: n = txtstepnum.Text
b = txtgriderw.Text: h = txtgriderh.Text: h0 = txtboardt.Text
If h0 >= h Or b > 80 Or s >= t Then
MsgBox "输入条件不符合要求,请检查参数的合理性!", vbCritical
Exit Sub
End If
ReDim ptarr1(2 * (2 * n + 2) - 1)
ptarr1(0) = x0 - 100: ptarr1(1) = y0
ptarr1(2) = x0: ptarr1(3) = y0
ptarr1(4) = x0: ptarr1(5) = y0 + s
Dim i As Integer
For i = 6 To 2 * (2 * n + 2) - 3
If i Mod 4 = 2 Then
ptarr1(i) = ptarr1(i - 4) + t
ElseIf i Mod 4 = 3 Then
ptarr1(i) = ptarr1(i - 4) + s
ElseIf i Mod 4 = 0 Then
ptarr1(i) = ptarr1(i - 2)
ElseIf i Mod 4 = 1 Then
ptarr1(i) = ptarr1(i - 2) + s
End If
Next i
ptarr1(2 * (2 * n + 2) - 2) = ptarr1(2 * (2 * n + 2) - 4) + 100
ptarr1(2 * (2 * n + 2) - 1) = ptarr1(2 * (2 * n + 2) - 3)
ptarr2(0) = x0 - 100: ptarr2(1) = y0 - h0
ptarr2(2) = x0 - b: ptarr2(3) = y0 - h0
ptarr2(4) = x0 - b: ptarr2(5) = y0 - h
ptarr2(6) = x0: ptarr2(7) = y0 - h
ptarr2(8) = x0: ptarr2(9) = y0 - h0
ptarr2(10) = x0 + (n - 1) * t: ptarr2(11) = y0 + (n - 1) * s - h0
ptarr2(12) = ptarr1(2 * (2 * n + 2) - 4): ptarr2(13) = ptarr1(2 * (2 * n + 2) - 3) - h
ptarr2(14) = ptarr2(12) + b: ptarr2(15) = ptarr2(13)
ptarr2(16) = ptarr2(14): ptarr2(17) = ptarr2(15) + (h - h0)
ptarr2(18) = ptarr1(2 * (2 * n + 2) - 2): ptarr2(19) = ptarr1(2 * (2 * n + 2) - 1) - h0
bcal = True
End Sub
Private Sub cmddraw_Click()
If bcal = False Then
MsgBox "请先进行计算,再进行绘图!", vbCritical
Exit Sub
End If
On Error Resume Next
Dim acadapp As AcadApplication
Set acadapp = GetObject(, "AutoCAD.Application.16")
If Err Then
Err.Clear
'MsgBox "sssssssssssss"
'Set acadapp = CreatObject("AutoCAD.Application.16")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
Dim acaddoc As AcadDocument
Set acaddoc = acadapp.ActiveDocument
acaddoc.ModelSpace.AddLightWeightPolyline ptarr1
acaddoc.ModelSpace.AddLightWeightPolyline ptarr2
ZoomAll
acadapp.Visible = True
bcal = False
End Sub
Private Sub cmdexit_Click()
End
End Sub
Private Sub Form_Load()
txtptx.Text = 0
txtpty.Text = 0
txtptz.Text = 0
txtsteph.Text = 20
txtstepw.Text = 40
txtstepnum.Text = 10
txtgriderw.Text = 25
txtgriderh.Text = 45
txtboardt.Text = 15
bcal = False
End Sub
因为VB和AutoCAD之间是通过COM技术连接,这种数据交换对系统资源的消耗很大,同样的计算在VB运算消耗的时间比在VBA中的运算时间要多5倍以上,在VB中按F5键运行程序,可以在Form中对楼梯参数进行设置,就可在CAD中绘制楼梯剖面图。创建VB程序时要尽可能减少程序和AutoCAD之间的数据交换,所有计算尽量在VB中完成,直接传递给AutoCAD计算结果,使CAD可以直接根据结果进行绘图。在VB中按下F5键,单击绘图按钮即可在CAD中看到绘制的楼梯剖面图。
Dim ptarr1() As Double
Dim ptarr2(19) As Double
Private Sub cmdcal_Click()
Dim objcontrol As Control
For Each objcontrol In Form1.Controls
If TypeOf objcontrol Is TextBox Then
If objcontrol.Text = "" Then
MsgBox "缺少参数,无法计算!", vbCritical
Exit Sub
End If
End If
Next
Dim x0 As Double, y0 As Double
Dim s As Double, t As Double, n As Double
Dim b As Double, h As Double, h0 As Double
x0 = txtptx.Text: y0 = txtpty.Text
s = txtsteph.Text: t = txtstepw.Text: n = txtstepnum.Text
b = txtgriderw.Text: h = txtgriderh.Text: h0 = txtboardt.Text
If h0 >= h Or b > 80 Or s >= t Then
MsgBox "输入条件不符合要求,请检查参数的合理性!", vbCritical
Exit Sub
End If
ReDim ptarr1(2 * (2 * n + 2) - 1)
ptarr1(0) = x0 - 100: ptarr1(1) = y0
ptarr1(2) = x0: ptarr1(3) = y0
ptarr1(4) = x0: ptarr1(5) = y0 + s
Dim i As Integer
For i = 6 To 2 * (2 * n + 2) - 3
If i Mod 4 = 2 Then
ptarr1(i) = ptarr1(i - 4) + t
ElseIf i Mod 4 = 3 Then
ptarr1(i) = ptarr1(i - 4) + s
ElseIf i Mod 4 = 0 Then
ptarr1(i) = ptarr1(i - 2)
ElseIf i Mod 4 = 1 Then
ptarr1(i) = ptarr1(i - 2) + s
End If
Next i
ptarr1(2 * (2 * n + 2) - 2) = ptarr1(2 * (2 * n + 2) - 4) + 100
ptarr1(2 * (2 * n + 2) - 1) = ptarr1(2 * (2 * n + 2) - 3)
ptarr2(0) = x0 - 100: ptarr2(1) = y0 - h0
ptarr2(2) = x0 - b: ptarr2(3) = y0 - h0
ptarr2(4) = x0 - b: ptarr2(5) = y0 - h
ptarr2(6) = x0: ptarr2(7) = y0 - h
ptarr2(8) = x0: ptarr2(9) = y0 - h0
ptarr2(10) = x0 + (n - 1) * t: ptarr2(11) = y0 + (n - 1) * s - h0
ptarr2(12) = ptarr1(2 * (2 * n + 2) - 4): ptarr2(13) = ptarr1(2 * (2 * n + 2) - 3) - h
ptarr2(14) = ptarr2(12) + b: ptarr2(15) = ptarr2(13)
ptarr2(16) = ptarr2(14): ptarr2(17) = ptarr2(15) + (h - h0)
ptarr2(18) = ptarr1(2 * (2 * n + 2) - 2): ptarr2(19) = ptarr1(2 * (2 * n + 2) - 1) - h0
bcal = True
End Sub
Private Sub cmddraw_Click()
If bcal = False Then
MsgBox "请先进行计算,再进行绘图!", vbCritical
Exit Sub
End If
On Error Resume Next
Dim acadapp As AcadApplication
Set acadapp = GetObject(, "AutoCAD.Application.16")
If Err Then
Err.Clear
'MsgBox "sssssssssssss"
'Set acadapp = CreatObject("AutoCAD.Application.16")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
Dim acaddoc As AcadDocument
Set acaddoc = acadapp.ActiveDocument
acaddoc.ModelSpace.AddLightWeightPolyline ptarr1
acaddoc.ModelSpace.AddLightWeightPolyline ptarr2
ZoomAll
acadapp.Visible = True
bcal = False
End Sub
Private Sub cmdexit_Click()
End
End Sub
Private Sub Form_Load()
txtptx.Text = 0
txtpty.Text = 0
txtptz.Text = 0
txtsteph.Text = 20
txtstepw.Text = 40
txtstepnum.Text = 10
txtgriderw.Text = 25
txtgriderh.Text = 45
txtboardt.Text = 15
bcal = False
End Sub
相关文章推荐
- [HTML5-SVG]利用 SVG 在 Web 应用程序中创建客户端图表交互
- Webix学习笔记-创建一个基本应用程序-03-和服务器交互之Retrieve
- VB创建多线程应用程序(二)
- 利用dbExpress创建Oracle数据库应用程序
- 利用 Project Zero 和 REST 设计原理创建相册应用程序
- 利用Asp.net 动态创建DataList--- VB
- 一、利用Visual Studio 2010创建第一个基于服务和数据驱动的Silverlight应用程序
- 利用AJAX在BS下实现CS模式下的可交互的应用程序
- 用VB.NET创建一个三层应用程序的例子……
- 创建ASP.NET Core MVC应用程序(2)-利用MySQL Connector NET连接到MySQL
- Webix学习笔记-创建一个基本应用程序-05-和服务器交互之Create
- [转] 如何用VB.Net创建一个三层的数据库应用程序
- 如何用VB.Net创建一个三层的数据库应用程序
- Webix学习笔记-创建一个基本应用程序-02-让组件交互
- Webix学习笔记-创建一个基本应用程序-06-和服务器交互之Update
- 利用Adobe AIR创建桌面对话应用程序
- 利用VB与AutoCAD链接进行CAD二次开发
- 利用WPF创建含多种交互特性的无边框窗体
- 利用VS 2003为应用程序创建简单的安装程序
- 利用Code First在MVC4中创建数据驱动应用程序