Author Topic: Writing Layers to a text file  (Read 7448 times)

0 Members and 1 Guest are viewing this topic.


  • Guest
Re: Writing Layers to a text file
« Reply #30 on: October 12, 2007, 06:06:41 PM »

You used The FSO object in the above code
You may not be able to do every ting you want with The File System Object, that is why you need to mix it up :)



  • Guest
Re: Writing Layers to a text file
« Reply #31 on: October 15, 2007, 12:58:11 PM »


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


Code: [Select]
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
 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


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