我有一个很好的代码来突出代码中命名的层(acadselectionset)。
我不想突出显示它们,而是想知道是否有可能使用sendcommand方法对命名层执行诸如擦除或draworder之类的操作。
这是原始代码:
- Public Sub highlighttest()
- Dim tSelSet As
- AcadSelectionSet
- Set tSelSet =
- getSelSetByLayer("Layer1,Layer2,Layer3,Layer4")
- If tSelSet Is
- Nothing Then
- MsgBox ("No
- Selectionset")
- ElseIf tSelSet.Count = 0
- Then
- MsgBox ("No objects found on
- Layers")
- Else
- Dim tEnt As
- AcadEntity
- For Each tEnt In
- tSelSet
- Select Case
- UCase(tEnt.Layer)
-
- Case "LAYER1",
- "LAYER2"
-
- tEnt.Highlight
- (True)
-
- Case "LAYER3",
- "LAYER4"
-
- tEnt.Highlight (False)
- End
- Select
- Next
- End If
- End
- Sub
- Private Function getSelSetByLayer(ByVal LayerName As String) As
- AcadSelectionSet
- Dim tRetVal As AcadSelectionSet
-
- On Error Resume Next
- 'create selectionset
- Set
- tRetVal = ThisDrawing.SelectionSets.Add("mySelSet")
- If tRetVal
- Is Nothing Then Set tRetVal =
- ThisDrawing.SelectionSets.Item("mySelSet")
- 'create filter for
- selection
- Dim tDxfCodes(0) As Integer: tDxfCodes(0) =
- 8 '8=dxfcode for "layername"
- Dim
- tDxfValues(0) As Variant: tDxfValues(0) = LayerName
-
- 'select
- tRetVal.Clear
- Call
- tRetVal.Select(acSelectionSetAll, , , tDxfCodes, tDxfValues)
-
- 'return
- Set getSelSetByLayer = tRetVal
- End Function
thanx gr.Laszlo |