[原创]帮忙找程序错误

zzz8662

总出现编译错误：在该对象模块派生的对象模块中成员已存在。
我用的是李风华《的AutoCAD 2002/2000 VBA开发指南》，程序总是会出错。谢谢大家指教
Sub copyobjects()
'定义变量
Dim circleobject As AcadCircle
Dim cenpoint(0 To 2) As Double
Dim radius As Double
Dim polylineobject As AcadLWPolyline
Dim plinevect(0 To 7) As Double

Dim cirobjectcopy As AcadCircle
Dim plineobjectcopy As AcadLWPolyline
Dim radiuscopy As Double

Dim objectcollection(0 To 1) As Object
Dim retobjects As Variant
Dim mspoint(0 To 2) As Double
Dim mepoint(0 To 2) As Double
'定义circle对象
cenpoint(0) = 0
cenpoint(1) = 0
cenpoint(2) = 0
radius = 6

plinevect(0) = 0
plinevect(1) = 0
plinevect(2) = 2
plinevect(3) = 5
plinevect(4) = 4
plinevect(5) = 7
plinevect(6) = 3
plinevect(7) = 12

'创建圆对象和多段线
Set circleobject = ThisDrawing.ModelSpace.AddCircle(cenpoint, radius)
Set polylineobject = ThisDrawing.ModelSpace.AddLightWeightPolyline(plinevect)

'将要复制的对象设置为与copyobjects兼容的形式
Set objectcollection(0) = circleobject
Set objectcollection(1) = polylineobject
'复制对象并返回新对象的集合
retobjects = ThisDrawing.copyobjects(objectcollection)
'取得新建的对象并套用新的属性到复制的对象

Set cirobjectcopy = retobject(0)
Set plineobjectcopy = retobject(1)
radiuscopy = 15
cenpoint(0) = 30
cenpoint(1) = 30
cenpoint(2) = 0
cirobjectcopy.radius = radiuscopy
cirobjectcopy.Center = cenpoint
cirobjectcopy.Linetype = "hidden"
cirobjectcopy.LinetypeScale = 0.5
mspoint(0) = 0
mspoint(1) = 0
mspoint(2) = 0
  mepoint(0) = 30
mepoint(1) = 30
mepoint(2) = 0
plineobjectcopy.Move mspoint, mepoint
plineobjectcopy.Linetype = "hidden"
plineobjectcopy.LinetypeScale = 0.5
ThisDrawing.Application.ZoomExtents

End Sub

topirol

因为copyobjects是内部过程，你把Sub copyobjects()改成Sub copyobjects1()就可以了

zzz8662

哦，对了。谢谢！