TheSwamp
Code Red => VB(A) => Topic started by: Matersammichman on November 01, 2006, 05:57:19 PM
-
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?
-
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?
1. Get a selection set of all acadblockreference and acadexternalreference objects.
2. Iterate through each item in the selection set setting its layer to "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
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
-
Thanks Mark, I'll give it a shot.
-
Mark,
Fantastic code!
Thanks!