社区 › VB › 错误图层上的块

Matersammichman 发表于 2006-11-1 17:57:19

错误图层上的块

VBA-
好吧，我被不在零层的块和外部参照所迷惑。
如何收集Blocks集合，然后将所有块和外部参照放置在图层0上？
**** Hidden Message *****

mohnston 发表于 2006-11-1 19:38:15

1。获取所有acadblockreference和acadexternalreference对象的选择集。
2。迭代选择集中的每个项目，将其图层设置为“0”。
Public Sub BlocksAndXrefsToZeroLayer()
    Dim oEnt As AcadEntity
    Dim I As Integer
    Dim oSS As AcadSelectionSet
    Dim iType(3) As Integer
    Dim vData(3) As Variant
    Dim P1(2) As Double
    Dim P2(2) As Double
    Set oSS = getSS("zlayer")
    iType(0) = -4: vData(0) = ""
    oSS.Select acSelectionSetAll, P1, P2, iType, vData
    If oSS.Count < 1 Then Exit Sub
    For I = 0 To oSS.Count - 1
      Set oEnt = oSS(I)
      If ThisDrawing.Layers(oEnt.Layer).Lock Then
            ' entity is on a locked layer - can't change it
      Else
            oEnt.Layer = "0"
            oEnt.Update
      End If
    Next
End Sub
Public Function getSS(strName As String) As AcadSelectionSet
    Dim SS As AcadSelectionSet
    On Error Resume Next
    ThisDrawing.SelectionSets(strName).Delete
    Set SS = ThisDrawing.SelectionSets.Add(strName)
    Set getSS = SS
End Function

Matersammichman 发表于 2006-11-2 06:06:48

谢谢马克，我会试一试的。

Matersammichman 发表于 2006-11-2 12:47:35

马克，
梦幻般的代码！
谢谢！

查看完整版本: 错误图层上的块