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

0 Members and 1 Guest are viewing this topic.

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: 4075
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.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

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: 4075
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.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

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: 4075
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.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

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: 4075
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.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

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: 4075
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.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4075
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.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4075
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.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)