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

0 Members and 1 Guest are viewing this topic.

ML

  • Guest
Writing Layers to a text file
« on: October 11, 2007, 06:51:08 PM »

Hi

I am trying to write out my layers from a drawing to a text file.
As far as creating the text file, that part is working fine; it is grabbing the drawing name and creating a text file however
I can not get the layers to write to the file.

My guess is because layers are an object and not a string, even though the layer names are a string..... hummm?????
If I replace the line MyFile.WriteLine ThisDrawing.Layers line with something like MyFile.WriteLine "Hello", it works just fine.

Does anyone know how I can get this to work?

Thank you,

Mark

Code: [Select]
Sub WriteLayersToATextFile()

Dim FSO, MyFile As Variant
Dim Layr As AcadLayer
Dim Dwgname As String


Set FSO = CreateObject("Scripting.FileSystemObject")


Dwgname = UCase(Left$(ThisDrawing.GetVariable("Dwgname"), Len(ThisDrawing.GetVariable("Dwgname")) - 8))
 
For Each Layr In ThisDrawing.Layers
 Set MyFile = FSO.CreateTextFile("I:\Path\Path\Path\Path\" & Dwgname & ".TXT", True)
 MyFile.WriteLine ThisDrawing.Layers
Next Layr

End Sub

Glenn R

  • Water Moccasin
  • Posts: 1932
  • What idiot child of married cousins wrote this?!
Re: Writing Layers to a text file
« Reply #1 on: October 11, 2007, 06:54:38 PM »
That's because you're trying to write out to the file the entire layer collection in one hit.

Change this:
Code: [Select]
MyFile.WriteLine ThisDrawing.Layers

to this:
Code: [Select]
MyFile.WriteLine Layr.Name
Me

Glenn R

  • Water Moccasin
  • Posts: 1932
  • What idiot child of married cousins wrote this?!
Re: Writing Layers to a text file
« Reply #2 on: October 11, 2007, 06:56:16 PM »
Also move your CreateTextFile line OUTSIDE of the for loop - before it in fact, otherwise you will be creating a textfile for each layer in the drawing.
Also don't forget to close the textfile when finished.
Me

ML

  • Guest
Re: Writing Layers to a text file
« Reply #3 on: October 11, 2007, 07:09:57 PM »

Dam Glenn

Without even trying it, I know you nailed it!

Of course layer.name DUH

Also, you are correct, if I keep the writetextfile in the loop, I would get a .txt file for each layer

I will move it out

Thank you very much!

Mark

ML

  • Guest
Re: Writing Layers to a text file
« Reply #4 on: October 11, 2007, 07:34:40 PM »

Actually,

This may seem like a dumb question but I can do
Set layrs = Thisdrawing.layers

However, if I pull the layr variable out of the loop, then it needs me to set a reference to layr
and I can only use the name method on individual layers

MyFile.WriteLine Layr.Name

So, how would I set a reference to the layr variable so that each layer in the layer collection can be read, then written?

I tried something like this, but no luck
Set layr = Thisdrawing.layers.item (0)

Thanks again,

Mark

Glenn R

  • Water Moccasin
  • Posts: 1932
  • What idiot child of married cousins wrote this?!
Re: Writing Layers to a text file
« Reply #5 on: October 11, 2007, 07:41:46 PM »
I don't follow you. Your code posted looks about right, but here is a quick example:

Code: [Select]
Public Sub SpewLayers()
    Dim pLayers As AcadLayers
    Dim pLayer As AcadLayer
   
    Set pLayers = ThisDrawing.Layers
   
    For Each pLayer In pLayers
        ThisDrawing.Utility.Prompt "Layer name: " & pLayer.Name & vbCrLf
    Next
End Sub
Me

ML

  • Guest
Re: Writing Layers to a text file
« Reply #6 on: October 11, 2007, 10:58:39 PM »

Hey Glenn

OK, I figured it out and you were partially right.
Absolutely, I had to use the layer.name method to get the layer name
However, the layr.name code must remain in the loop for AutoCAD to grab the name of each layer in the layer collection.
As far as The Writeline method; it will do precisely that; it will write a line for each in layer in the layer collection
Also, as you add layers, you can re run the macro and it will overwrite the existing file with the new layers.

So, here is the working code:

Thank you for the help!

Mark

Code: [Select]
Sub WriteLayersToATextFile()

Dim FSO, MyFile As Variant
Dim Layr As AcadLayer
Dim Layrs As AcadLayers
Dim Dwgname As String

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Layrs = ThisDrawing.Layers

Dwgname = UCase(Left$(ThisDrawing.GetVariable("Dwgname"), Len(ThisDrawing.GetVariable("Dwgname")) - 4))
Set MyFile = FSO.CreateTextFile("C:\Path\Path\Path\" & Dwgname & ".TXT", True)
 
For Each Layr In ThisDrawing.Layers
 MyFile.WriteLine Layr.Name
Next Layr

MyFile.Close

End Sub

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Writing Layers to a text file
« Reply #7 on: October 11, 2007, 11:30:00 PM »

Hey Glenn

OK, I figured it out and you were partially right.
Absolutely, I had to use the layer.name method to get the layer name
However, the layr.name code must remain in the loop for AutoCAD to grab the name of each layer in the layer collection.


Mark, I read that Glenn said move the File creation, not the file WriteLine.
.. I can't see where he suggested relocating the MyFile.WriteLine Layr.Name
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

Glenn R

  • Water Moccasin
  • Posts: 1932
  • What idiot child of married cousins wrote this?!
Re: Writing Layers to a text file
« Reply #8 on: October 11, 2007, 11:32:11 PM »
However, the layr.name code must remain in the loop for AutoCAD to grab the name of each layer in the layer collection.

Of course...I never said to remove it from the loop.
Me

Glenn R

  • Water Moccasin
  • Posts: 1932
  • What idiot child of married cousins wrote this?!
Re: Writing Layers to a text file
« Reply #9 on: October 11, 2007, 11:33:47 PM »
OK, I figured it out and you were partially right.

No, my answer was exactly right for the question asked.

Kerry, you beat me to it.
Me

ML

  • Guest
Re: Writing Layers to a text file
« Reply #10 on: October 12, 2007, 10:01:41 AM »

From your second post:
Quote
Also move your CreateTextFile line OUTSIDE of the for loop - before it in fact, otherwise you will be creating a textfile for each layer in the drawing.
Also don't forget to close the textfile when finished.

OK, you're right, you said move the CreateTextFile line outside of the loop.

My fault.

You were right......feel better? :)

Thank you again

Mark


ML

  • Guest
Re: Writing Layers to a text file
« Reply #11 on: October 12, 2007, 10:04:24 AM »

I was very tired yesterday.
Sorry guys....
I looked at it last night and it then hit me.
It goes to show that sometimes you do need to walk away from it

Well, anyway, may be someone else will benefit from the final result "posted"

Thank you again

Mark

M-dub

  • Guest
Re: Writing Layers to a text file
« Reply #12 on: October 12, 2007, 10:04:32 AM »
Just a quick note, you might find something helpful here -> http://www.theswamp.org/index.php?topic=1341.15

ML

  • Guest
Re: Writing Layers to a text file
« Reply #13 on: October 12, 2007, 10:09:00 AM »

Cool
Thanks M-

Mark

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4043
Re: Writing Layers to a text file
« Reply #14 on: October 12, 2007, 10:21:18 AM »

Why not add Layer.Color and Layer.Linetype and make it tab delimited, then you can pull it into Excel?
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ML

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


Yeah, that is a cool idea CM and I have done something similar in other cases but I guess I never described what I am using it for.

My boss wrote a LISP routine that will grab the layers from the supporting text files (which I am creating with this code)
create a filter in a user's drawing based on those layers, then grab the drawing prefix (dwgprefix) for the project path and use the text file name & ".dwg" to create the nec. AutoCAD (xref) drawing.

We are a very xref friendly company here so this will make it much easier for the user to create the nec. xrefs for their project relativily quickly.

Having said that; I am simply writing some supporting code.

Now, if a person (CAD User) on the floor, or the company overall needs to add a layer(s) for future xrefs, then can just add or delete it from our master dwg xref files, then run this code to regenerate the new text file.

"If someone would like to help me further develop this, I need the layer count minus defpoints and 0 then write that as the first line in the text file, then after that will follow the layernames minus 0 and defpoints.

That would be really cool if someone wants to take my exisiting code and expound on it.


Thank you

Mark



ML

  • Guest
Re: Writing Layers to a text file
« Reply #16 on: October 12, 2007, 11:13:28 AM »

Note:

After the filter is created in the drawing, it will obviously be wblocked out but that is all done in The LISP routine, I am just focusing on the text file part

Mark

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4043
Re: Writing Layers to a text file
« Reply #17 on: October 12, 2007, 01:55:11 PM »
Post your code and I will see what I can add
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ML

  • Guest
Re: Writing Layers to a text file
« Reply #18 on: October 12, 2007, 01:59:15 PM »

I did CM but here it is again
This will likely require more VBScripting
I appreciate it.
I will also look at it again later if I get time

Thank you very much,
Mark

Code: [Select]
Sub WriteLayersToATextFile()

Dim FSO, MyFile As Variant
Dim Layr As AcadLayer
Dim Dwgname As String

Set FSO = CreateObject("Scripting.FileSystemObject")

Dwgname = UCase(Left$(ThisDrawing.GetVariable("Dwgname"), Len(ThisDrawing.GetVariable("Dwgname")) - 4))
Set MyFile = FSO.CreateTextFile("C:\Path\Path\Path\" & Dwgname & ".TXT", True)
 
For Each Layr In ThisDrawing.Layers
 MyFile.WriteLine Layr.Name
Next Layr

MyFile.Close

End Sub


David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4043
Re: Writing Layers to a text file
« Reply #19 on: October 12, 2007, 02:28:40 PM »
try this, It puts in the layer cuont at top and bottom.  They should match if defpoints exists, or be off by one if not
Code: [Select]
Option Explicit

Sub WriteLayersToATextFile()

      Dim FSO, MyFile As Variant
      Dim Layr As AcadLayer
      Dim Dwgname As String
      Dim intLayerCount As Integer
      Set FSO = CreateObject("Scripting.FileSystemObject")

      Dwgname = UCase(Left$(ThisDrawing.GetVariable("Dwgname"), Len(ThisDrawing.GetVariable("Dwgname")) - 4))
      Set MyFile = FSO.CreateTextFile("C:\" & Dwgname & ".TXT", True)
      intLayerCount = ThisDrawing.Layers.Count - 2
      MyFile.writeline intLayerCount
      intLayerCount = 0
      For Each Layr In ThisDrawing.Layers
            If Not Layr.Name = "0" Then
            If Not Layr.Name = "Defpoints" Then
                  MyFile.writeline Layr.Name
                  intLayerCount = intLayerCount + 1
            End If
            End If
      Next Layr
      MyFile.writeline intLayerCount
      MyFile.Close

End Sub
« Last Edit: October 12, 2007, 02:31:53 PM by CmdrDuh »
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ML

  • Guest
Re: Writing Layers to a text file
« Reply #20 on: October 12, 2007, 02:53:48 PM »

CM

I have not tried the code yet and I am about to
However, I think with the way that VBScript and The Text Stream methods work, I may need to write it

Code: [Select]
MyFile.writeline intLayerCount & MyFile.writeline Layr.Name

But let's see how it handles it

Thank you for the code

I will try it now

Mark

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4043
Re: Writing Layers to a text file
« Reply #21 on: October 12, 2007, 03:12:30 PM »
I didn't put any error checking for the layer Defpoints, thats why the layer numbers were there.  You could also use the layer number piece to number your layers
Code: [Select]
Myfile.writeline intlayercount & vbtab and layer.name to number them.
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ML

  • Guest
Re: Writing Layers to a text file
« Reply #22 on: October 12, 2007, 03:22:57 PM »

Yes that is cool but I can't for this one because The LISP routine reads the top number for the layer count
Then the layers.


ML

  • Guest
Re: Writing Layers to a text file
« Reply #23 on: October 12, 2007, 03:35:23 PM »

CM
Thanks again; I really appreciate it
I tweaked it a bit and it seems to be working fine:
I also added in the username method, so it will write the file directly to your desktop if you want to test it

Code: [Select]
Sub WriteLayersToATextFile2()

Dim FSO, MyFile, Username As Variant
Dim Layr As AcadLayer
Dim Dwgname As String
Dim intLayerCount 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")) - 8))
intLayerCount = ThisDrawing.Layers.Count - 2

Set MyFile = FSO.CreateTextFile("C:\Documents and Settings\" & Username & "\Desktop\" & Dwgname & ".TXT", True)

MyFile.writeline intLayerCount

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

I still need to see what will happen if I defpoints does not exist in a drawing

Mark

ML

  • Guest
Re: Writing Layers to a text file
« Reply #24 on: October 12, 2007, 03:36:49 PM »

Oh by the way
The code I just posted is dropping 8 characters off the end of the drawing name; I have to try something differet.
You may want to change that back to 4

Mark

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4043
Re: Writing Layers to a text file
« Reply #25 on: October 12, 2007, 04:44:07 PM »
I took your idea and started writing a Standards Checker that checks fonts, layers, layers for certain blks, etc. I'll post if anybody is interested
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ML

  • Guest
Re: Writing Layers to a text file
« Reply #26 on: October 12, 2007, 05:34:58 PM »

What idea was that CM?

Of course I would be interested but ACAD has a built in Standards checker (CAD Standards Toolbar)

Mark

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4043
Re: Writing Layers to a text file
« Reply #27 on: October 12, 2007, 05:40:03 PM »
I couldn't figure out how to get all my standards into the checker, so I started writing my own
Code: [Select]
Option Explicit

Public Sub GetInfoLayers()
      Dim FSO, MyFile As Variant
      Dim objLayer As AcadLayer, objFont As AcadTextStyle
      Dim strDwgName As String
      Dim strLayername As String, strLayerLinetype As String, strLayerColor As String
            ThisDrawing.PurgeAll
            ThisDrawing.PurgeAll
            ThisDrawing.PurgeAll
      Set FSO = CreateObject("Scripting.FileSystemObject")
      strDwgName = UCase(Left$(ThisDrawing.GetVariable("Dwgname"), Len(ThisDrawing.GetVariable("Dwgname")) - 4))
      Set MyFile = FSO.CreateTextFile("C:\" & strDwgName & ".TXT", True)
      MyFile.WriteLine "Drawing: " & strDwgName & ", located at: " & ThisDrawing.Path & "\"


CheckLayers:
      MyFile.WriteLine " "
      MyFile.WriteLine "Non Standard Layers: "
      For Each objLayer In ThisDrawing.Layers
            strLayername = objLayer.Name
            strLayerLinetype = objLayer.Linetype
            strLayerColor = objLayer.color
            If CheckName(strLayername) = 1 Then
                  MyFile.WriteLine strLayername & vbTab & strLayerLinetype & vbTab & strLayerColor
            End If
      Next objLayer

CheckFonts:
      MyFile.WriteLine " "
      MyFile.WriteLine "Non Standard Fonts:"
      For Each objFont In ThisDrawing.TextStyles
            Select Case UCase(objFont.fontFile)
            Case "ROMANS.SHX"
            Case "VERDANA.TTF"
            Case Else
                  MyFile.WriteLine objFont.Name
            End Select
      Next objFont
CheckTitleBlocks:

CheckImages:
      MyFile.WriteLine " "
      Dim objRasterImage As AcadRasterImage
'      For Each objRasterImage In ThisDrawing.ModelSpace
'            If Not objRasterImage.Layer = "ANNO-SCAN" Then
'                  MyFile.WriteLine "Image: " & objRasterImage.Name & " wrong layer, on layer " & objRasterImage.Layer
'            End If
'      Next
      MyFile.Close
End Sub

Private Function CheckName(LayerName As String) As Integer
      Dim FSO, MyLayerFile As Variant
      Dim strLayername As String
      '      Set FSO = CreateObject("Scripting.FileSystemObject")
      '      'Set MyLayerFile = FSO.OpenTextFile("c:\layer.txt", ForReading, False, TristateFalse)
      Open "c:\layer.txt" For Input As #1      ' txt file is list of good layers to check against
      While Not EOF(1)
            Line Input #1, strLayername
            If LayerName = strLayername Then
                  Close #1
                  GoTo Good
            End If
      Wend
      Close #1
      CheckName = 1
      Exit Function
Good:
      CheckName = 0
      Exit Function
End Function
This is how far I have gotten so far today, NO ERROR checking, so use at your own risk
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4043
Re: Writing Layers to a text file
« Reply #28 on: October 12, 2007, 05:42:03 PM »
Im purging 3 times b/c I haven't checked if this method will purge nested entities completly.
Also, the layer checker , I couldn't figure out how to use the FSO object and EOF so I reverted back to VBA Open for Input
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4043
Re: Writing Layers to a text file
« Reply #29 on: October 12, 2007, 05:43:47 PM »
I also need to add to the font checker to put the text style as well as font file
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ML

  • 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 :)

Mark

ML

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

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

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
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