- 积分
- 282
- 明经币
- 个
- 注册时间
- 2003-4-20
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
在visualbasic中编程,碰到了一个问题:运行到类似Set boxobj = acadApp.ActiveDocument.ModelSpace.AddBox(boxcenter, boxlength, boxwidth, boxheight)的语句,就会出现:
实时错误‘424’
要求对象
结束(E) 调试(D) 帮助(H)
因为没有安装msdn,所以就不知道问题出在哪里了 !请好心的您解决我这个问题吧!!
不甚感激!!!
具体程序如下:
Private Sub Form_Load()
On Error Resume Next
'与AutoCAD通信
Dim acadApp As AcadApplication
Set acadApp = GetObject _
(, "AutoCAD.Application")
If Err Then
Err.Clear
Set acadApp = CreateObject _
("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
'连接autocad,并使其画图
Dim acadDoc As AcadDocument
Set acadDoc = acadApp.ActiveDocument
End Sub
Private Sub Command1_Click()
Dim boxobj As Acad3DSolid
Dim boxlength As Double, boxwidth As Double, boxheight As Double
Dim boxcenter(0 To 2) As Double
boxcenter(0) = 5#: boxcenter(1) = 5#: boxcenter(2) = 0
boxlength = 10#: boxwidth = 7: boxheight = 10#
Set boxobj = acadApp.ActiveDocument.ModelSpace.AddBox(boxcenter, boxlength, boxwidth, boxheight)
boxobj.Color = acBlue
Dim cylinderobj As Acad3DSolid
Dim cylindercenter(0 To 2) As Double
Dim cylinderradius As Double
Dim cylinderheight As Double
cylindercenter(0) = 0#: cylindercenter(1) = 0#: cylindercenter(2) = 0#
cylinderradius = 5#
cylinderheight = 20#
Set cylinderobj = acadApp.activedocement.ModelSpace.AddCylinder(cylindercenter, cylinderradius, cylinderheight)
cylinderobj.Color = acBlue
boxobj.Boolean acIntersection, cylinderobj
boxobj.Color = acRed
Dim newdirection(0 To 2) As Double
newdirection(0) = -1: newdirection(1) = -1: newdirection(2) = 1
acadApp.ActiveDocument.ActiveViewport.Direction = newdirection
acadApp.ActiveDocument.Preferences.ContourLinesPerSurface = 20
ZoomExtents
acadApp.ActiveDocument.Regen True
End Sub |
|