|
|
发表于 2007-5-28 20:24:00
|
显示全部楼层
Dim sset As AcadSelectionSet ThisDrawing.SelectionSets.Item("path").Delete
Set sset = ThisDrawing.SelectionSets.Add("path")
Dim objs() As AcadEntity
Dim zhongzhuan As Double
Dim Entity As AcadEntity
sset.SelectOnScreen '在屏幕上面选线段
For Each Entity In sset '如果块已经定义则不需要重新定义
If Entity.ObjectName = "AcDbBlockReference" Then '"AcDbBlockBegin"blockReference
If Entity.Name = "sleeper" Then
Set blockRefObj = Entity.Copy()
' MsgBox "wwww"
GoTo insertkuai
End If
End If
Next
End
Dim insertionPnt As Variant
insertionPnt = ThisDrawing.Utility.GetPoint(, "拾取块的中点")
Set blockObj = ThisDrawing.Blocks.Add _
(insertionPnt, "sleeper")
For Each element In blockObj
element.Delete
Next
ReDim objs(sset.Count - 1)
Dim i
For i = 0 To sset.Count - 1
Set objs(i) = sset(i)
Next i
ThisDrawing.CopyObjects objs, blockObj
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
(insertionPnt, "sleeper", 1#, 1#, 1#, 0) |
|
置顶卡
