|
|
在visualbasic中编程，碰到了一个问题：运行到类似Set boxobj = acadApp.ActiveDocument.ModelSpace.AddBox(boxcenter, boxlength, boxwidth, boxheight)的语句，就会出现：
实时错误‘424’
要求对象
结束（E） 调试（D） 帮助（H）
因为没有安装msdn，所以就不知道问题出在哪里了 ！请好心的您解决我这个问题吧！！
不甚感激！！！
具体程序如下：
Private Sub Form_Load()
On Error Resume Next
'与通信
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 |
|
置顶卡
