[编程交流] 检查锁定层。。

Private Sub AcadDocument_BeginSave(ByVal FileName As String)
Dim block As AcadBlock
Dim ent As AcadEntity
Dim DimEnt As AcadDimension
Dim override As String
Dim LayerX As AcadLayer
For Each block In ThisDrawing.Blocks 'Loop through blocks for layouts..
   If block.IsLayout Then 'Is the block a layout..
       For Each ent In block 'Loop through objects in the layout..
               If ent.ObjectName Like "AcDb*Dimension" Then
                   Set DimEnt = ent
                   [color=red]Set LayerX = DimEnt.Layer[/color]
                   [color=red]If LayerX.Lock = False Then 'If layer is not locked..[/color]
                   override = UCase$(DimEnt.TextOverride)
                       If override = "" Then
                           ' Not overridden, so normal dimtext colour should be "ByLayer"..
                           DimEnt.TextColor = acByLayer
                       ElseIf override Like "<>?*" Or override Like "?*<>" Or override Like "?*<>?*" Or override Like "?*\P<>?*" Or override Like "?*<>\P?*" Then
                           ' Overridden but dynamic <>, so dimtext colour should be "ByLayer"..
                           DimEnt.TextColor = acByLayer
                       ElseIf IsNumeric(override) Then
                           ' Overridden and NOT dynamic (dim value as text), so dimtext colour should be "Green"..
                           DimEnt.TextColor = 80
                       ElseIf IsLike(override, "# [A-Z]*,## [A-Z]*,### [A-Z]*,#### [A-Z]*") Then
                           ' Overridden with text and numerical, so dimtext colour should be "Green"..
                           DimEnt.TextColor = 80
                       Else
                           ' We failed to trap the override's characteristics so this is "Green"..
                           DimEnt.TextColor = 80
                       End If 'End if for TextOverride checking..
                   End If
               [color=red]Else 'If layer is locked..[/color]
[color=red]                   MsgBox "One or more dimensions are on locked layers. These will be ignored..", vbInformation, ThisDrawing.Name[/color]
[color=red]               End If 'Is Layer locked?[/color]
       Next ent 'End ent FOR loop..
   End If 'If block is Layout..
Next block 'End main FOR loop..
End Sub

Public Sub UnlockAllLayers()
'------------------------------------------------------------------------------
'Cycle through layer collection, unlock any locked layer
'------------------------------------------------------------------------------
Dim acLyrs As AcadLayers
Dim acLyr As AcadLayer
'''''''''''''''''''''''''''''''''''''''
On Error GoTo ErrHandler
Set acLyrs = ThisDrawing.Layers
For Each acLyr In acLyrs
   acLyr.Lock = False
Next acLyr
Exit Sub
           
ErrHandler:
   Debug.Print Err.Number, Err.description, " In UnlockAllLayers"
End Sub