检查锁定层。。
你好我在我们的模板中内置了这段代码,如果任何维度已被文本编辑,它将标记(更改文本颜色)任何非动态维度。。
但是,如果任何维度位于锁定层上,例程就会崩溃。
在下面的代码中,我添加了几行我认为应该在那里的代码(红色),但似乎不起作用-在“”行标记无效标识符的错误
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
Set LayerX = DimEnt.Layer
If LayerX.Lock = False Then 'If layer is not locked..
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
Else 'If layer is locked..
MsgBox "One or more dimensions are on locked layers. These will be ignored..", vbInformation, ThisDrawing.Name
End If 'Is Layer locked?
Next ent 'End ent FOR loop..
End If 'If block is Layout..
Next block 'End main FOR loop..
End Sub
有没有关于如何检查锁定层的想法?我只想忽略这一层上的任何东西真的。。 实体Layer仅返回实体所在层的名称。而不是:
设置LayerX=尺寸。层
使用:
设置LayerX=此图形。层。项目(尺寸层) 这里有一个我经常跑的。。。
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
我喜欢先解锁所有层的想法,但这难道不需要更多的处理时间吗?还有,我该如何编写代码,使之前锁定的任何层在之后都会再次锁定? 嗯,你必须决定你想做什么。如果需要获取图层,请检查其状态,解锁,执行某些操作,将其返回到以前的状态,然后执行下一个操作。这相当直接。如果您想记住所有设置的位置,然后稍后将其返回到该状态,那么您可能会制作一个层名称及其状态的数组,做些什么,然后拉出该数组并将其返回到以前的状态。
页:
[1]