Sub wm()
Dim ent As AcadEntity
Dim tet As String
ThisDrawing.Utility.InitializeUserInput 0, "k a"
tet = ThisDrawing.Utility.GetKeyword _
(vbCrLf & "输入选项[框选(k)/全图(a)](a): ")
If tet = "" Or Err Then tet = "a"
If tet = "a" Then
For Each ent In ThisDrawing.ModelSpace
If ent.Linetype = "ACAD_ISO05W100" Then
' On Error Resume Next
Dim layc As AcadLayer
Set layc = ThisDrawing.Layers.Add("粗实线")
layc.color = acWhite
layc.Lineweight = acLnWt050
ent.Layer = "粗实线"
ent.color = acByLayer
ent.Lineweight = acLnWtByLayer
ent.Linetype = "ACAD_ISO05W100"
End If
Next
End If
If tet = "k" Then
Dim ss As AcadSelectionSet
Set ss = GetSelSet
For Each ent In ss
If ent.Linetype = "ACAD_ISO05W100" Then
' On Error Resume Next
Dim layc1 As AcadLayer
Set layc1 = ThisDrawing.Layers.Add("粗实线")
layc1.color = acWhite
layc1.Lineweight = acLnWt050
ent.Layer = "粗实线"
ent.color = acByLayer
ent.Lineweight = acLnWtByLayer
ent.Linetype = "ACAD_ISO05W100"
End If
Next
End If
ThisDrawing.PurgeAll
End Sub
Function GetSelSet() As AcadSelectionSet
Dim ss As AcadSelectionSet
Dim ssName As String
ssName = "PICKFIRST"
On Error Resume Next
Set ss = ThisDrawing.SelectionSets.Add(ssName)
If Err Then
Set ss = ThisDrawing.SelectionSets(ssName)
ss.Delete
End If
Set ss = ThisDrawing.PickfirstSelectionSet
If ss.Count = 0 Then
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
ss.SelectOnScreen
End If
Set GetSelSet = ss
ThisDrawing.SetVariable "filedia", 1
End Function
页:
1
[2]