hardwired Posted October 20, 2011 Share Posted October 20, 2011 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 Quote Link to comment Share on other sites More sharing options...
RMS Posted November 16, 2011 Share Posted November 16, 2011 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." Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.