25 | 03 | 2017

Change Block Layer

Code below changes the layer of a block

Sub ChangeBlockEntLayer(oblkname As String, oldLayer As String, newLayer As String)
    Dim blkDef As AcadBlock
    Dim acadEnt As AcadEntity
 
    On Error Resume Next
    Err.Clear
    Set blkDef = ThisDrawing.Blocks.Item(oblkname)
    If Err.Number <> 0 Then
        Exit Sub
    End If
    For Each acadEnt In blkDef
      If acadEnt.Layer = oldLayer Then
        acadEnt.Layer = newLayer
      End If
    Next
End Sub
Login

Sign up now and upload your code to the website.

Help us to continue.....
Statistics
Articles View Hits
2208275
Latest Articles