0 Members and 1 Guest are viewing this topic.
VBA-Okay, I am ***** by blocks and xrefs that do not reside on layer zero.How do I collect the Blocks collection, then place all of the blocks and xrefs on layer 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) = "<OR" iType(1) = 0: vData(1) = "INSERT" iType(2) = 0: vData(2) = "XREF" iType(3) = -4: vData(3) = "OR>" 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 NextEnd SubPublic 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 = SSEnd Function