[已解决]QueryInterface IID_IAcadBaseObject 失败 如何解决??
本帖最后由 作者 于 2008-6-6 17:06:57 编辑下面这段代码是CAD2006VBA参考上的例子,我做了部分修改。
这段代码在一台电脑上运行能正常,但到另一台电脑上却在此语句
retObjects = DOC1.CopyObjects(objCollection, DOC2)
处报错:QueryInterface IID_IAcadBaseObject 失败
请教此错误是如何产生的?应该如何解决? Sub Example_CopyObjects()
' This example creates a Circle object and uses the CopyObjects
' method to make a copy of the new Circle.
Dim DOC1 As AcadDocument
Dim DOC2 As AcadDocument
Dim circleObj1 As AcadCircle, circleObj2 As AcadCircle
Dim circleObj1Copy As AcadCircle, circleObj2Copy As AcadCircle
Dim centerPoint(0 To 2) As Double
Dim radius1 As Double, radius2 As Double
Dim radius1Copy As Double, radius2Copy As Double
Dim objCollection(0 To 1) As Object
Dim retObjects As Variant
' Define the Circle object
centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0
radius1 = 5#: radius2 = 7#
radius1Copy = 1#: radius2Copy = 2#
' Create a new drawing
Set DOC2 = Documents(0)
Set DOC1 = Documents.Add
' Add two circles to the drawing
Set circleObj1 = DOC1.ModelSpace.AddCircle(centerPoint, radius1)
Set circleObj2 = DOC1.ModelSpace.AddCircle(centerPoint, radius2)
ThisDrawing.Application.ZoomAll
' Copy objects
'
' First put the objects to be copied into a form compatible with CopyObjects
Set objCollection(0) = circleObj1
Set objCollection(1) = circleObj2
' Copy object and get back a collection of the new objects (copies)
retObjects = DOC1.CopyObjects(objCollection, DOC2)
' Get newly created object and apply new properties to the copies
Set circleObj1Copy = retObjects(0)
Set circleObj2Copy = retObjects(1)
circleObj1Copy.Radius = radius1Copy
circleObj2Copy.Radius = radius2Copy
ThisDrawing.Application.ZoomAll
' MsgBox "Circles copied."
End Sub
不好意思,是我粗心大意,把代码打漏了,应该是这样就对了: retObjects = DOC1.CopyObjects(objCollection, DOC2.ModelSpace)
页:
[1]