CM
Thanks again for your ongoing help!
With the function you supplied;
The macro with now check to see if defpoints exist.
If True
The layer count will be -2
If False
The layer count will be -1
Precisely what I needed.
Below is the code with function
Mark
Sub WriteLayersToText()
Dim FSO, MyFile, Username As Variant
Dim Layr As AcadLayer
Dim Dwgname As String
Dim LayerCount As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshNetwork = CreateObject("WScript.Network")
Username = WshNetwork.Username
Dwgname = UCase(Left$(ThisDrawing.GetVariable("Dwgname"), Len(ThisDrawing.GetVariable("Dwgname")) - 4))
If DoesLayerExist("Defpoints") = True Then
LayerCount = ThisDrawing.Layers.Count - 2
Else
LayerCount = ThisDrawing.Layers.Count - 1
End If
Set MyFile = FSO.CreateTextFile("C:\Documents and Settings\" & Username & "\Desktop\" & Dwgname & ".TXT", True)
'MsgBox LayerCount
MyFile.writeline LayerCount
For Each Layr In ThisDrawing.Layers
If Not Layr.Name = "0" Then
If Not Layr.Name = "Defpoints" Then
MyFile.writeline Layr.Name
End If
End If
Next Layr
MyFile.Close
End Sub
Private Function DoesLayerExist(ByRef Layername As String) As Boolean
Dim Layer As AcadLayer
For Each Layer In ThisDrawing.Layers
If UCase(Layer.Name) = UCase(Layername) Then
DoesLayerExist = True
Exit Function
End If
Next Layer
DoesLayerExist = False
End Function