sendcommand“draworder”指令
我有一个很好的代码来突出代码中命名的层（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 请阅读代码发布指南。
然后编辑你的帖子。谢谢 SLW210，
很抱歉我已经编辑了原始帖子。现在我希望有人能帮助我。
拉兹洛先生 谢谢你，lanieuwe。
页:
[1]