Jump to content

VBA - Checking for locked layers!!!


hardwired

Recommended Posts

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 AcadBlock
Dim ent As AcadEntity
Dim diment As AcadDimension
Dim 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, "# [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
       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 Boolean
If 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 = False
Else
   IsLike = text Like pattern
End If
End Function
' *********************************
' Function for checking dim text..
' *********************************

...thanks in advance :)

Link to comment
Share on other sites

  • 4 weeks later...

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." 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...