|
|
发表于 2004-3-13 17:34:00
|
显示全部楼层
针对你的程序改了一下.如下: Sub join()
Dim ss As AcadSelectionSet
Dim po(0 To 2) As Double
On Error Resume Next
po(0) = 0
po(1) = 0
po(2) = 0
'ThisDrawing.Blocks.Item("ok").Delete
Dim bk As AcadBlock
Set bk = ThisDrawing.Blocks.Add(po, "tempb")
Set ss = ThisDrawing.SelectionSets.item("ssss")
'------------------------------------------------
If Err Then
Err.Clear
Set ss = ThisDrawing.SelectionSets.Add("ssss")
End If
'------------------------------------------------
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim i As Long
ftype(0) = 8
fdata(0) = "layer"
ss.Select acSelectionSetAll, , , ftype, fdata '过滤
ReDim retVal(0 To ss.count - 1) As AcadEntity
For i = 0 To ss.count - 1
Set retVal(i) = ss.item(i)
Next
''------------------------------------------------过滤对象
'Dim retVal(), Ent As AcadEntity
'
'
'Dim i As Integer
'i = 0
'
' ReDim retVal(0 To ss.count - 1)
'
' For Each Ent In ss
'
' If (Ent.layer = "layer") Then
' Set retVal(i) = Ent
' i = i + 1
' End If
'
' Next
' ReDim Preserve retVal(0 To i - 1)
'------------------------------------------------
ThisDrawing.CopyObjects retVal, bk ' 在这里出问题了
Erase retVal
End Sub |
|
置顶卡
