VBA - Checking for locked laye
Hi,A while ago, i was helped out with some VBA code to change any 'edited' (non-dynamic) dimensions text to green so it could easily be spotted in the model that a particular dimension has been amended - this works brilliantly, however if anyone has a locked layer (and not necessarily the layer with text on), the code freaks out and errors. Could someone check out the code below and let me know what i need to amend or add to make it work ie check for locked layers and skip them or something ↓↓↓
Option Explicit' *************************************************************************' Override dim text colour if TextOverride is non-dynamic dimension value..' *************************************************************************Private Sub AcadDocument_BeginSave(ByVal FileName As String)Dim block As AcadBlockDim ent As AcadEntityDim diment As AcadDimensionDim override As String 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 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, "# *,## *,### *,#### *") 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 Next ent 'End ent FOR loop.. End If 'If block is Layout..Next block 'End main FOR loop..End Sub' *************************************************************************' Override dim text colour if TextOverride is non-dynamic dimension value..' *************************************************************************' *********************************' Function for checking dim text..' *********************************Function IsLike(text As String, pattern As String) As BooleanIf InStr(pattern, ",") > 0 Then Dim patterns() As String Dim i As Integer patterns = Split(pattern, ",") For i = 0 To UBound(patterns) If text Like patterns(i) Then IsLike = True Exit Function End If Next i IsLike = FalseElse IsLike = text Like patternEnd IfEnd Function' *********************************' Function for checking dim text..' *********************************
...thanks in advance This code is from this web site, in fact I think a lot of members post here as well!
http://www.vbaexpress.com/kb/getarticle.php?kb_id=884
'Iterates through all the layers and stores 'their visibility and locked values. Then turns 'on all layers. For Each objLayer In ThisDrawing.Layers If objLayer.Name"0" Then ReDim Preserve varLay(0 To 3, i) varLay(0, i) = objLayer.Name varLay(1, i) = objLayer.Freeze varLay(2, i) = objLayer.LayerOn varLay(3, i) = objLayer.Lock objLayer.Freeze = False objLayer.LayerOn = True objLayer.Lock = False i = i + 1 End If Next ThisDrawing.Utility.Prompt vbCrLf & "All layers are on, thawed & unlocked."
页:
[1]