list of layers
I need to copy list of layers, including ST style column, from history windows.But this field is not provided in the history. A JPGscreenshot won't help me.Support first told me:"Since the Style column is not included in the List option of the layer command, you need to use VBA or LISP to create such output." Any VBA snippet/ ± example available for this?Thanks on forward
Comments
-
If you want the list of layers and their status, color, linetype, etc. exported to a .TXT file, you can use LAYEROUT.LSP, by Stig Madsen.Go to http://intervision.hjem.wanadoo.dk/ and select "AutoLisp Archive" on the left menu, then skip down to the 4th routine.There are several other nice free lisp routines there, too. I like MDIST, for measuring cumulative distance along a complex path.
0 -
I can give you this VBA code. I don't believe it lists ST style (what is ST style?), but I assume you'll be able to adapt it to include that.Some explaination:The routine stores layer status data in the array arLayer(i). It adds data several times with the arLayer(i) = arLayer(i) & " ... ... ..." statementThis type of code is used to align:(" ", 4 - VBA.Len(VBA.CStr(It then sorts the layers, writes the array to a TXT file and opens it in notepad' ****************MAIN*************************************************************' Copyright © : Gerrit Kiers, 2006-2007' Date : 09 November 2007' This routine is provided free of charge without any warranty of any kind.' ****************PROCEDURES AND FUNCTIONS*****************************************' Sub LayerStatus2txt()' Public Sub sortStr(intLB As Integer, intUB As Integer, arrayText() As String)' ****************COMMENT**********************************************************' Rewritten and improved for Bricscad V8' ****************VARIABELS AND DECLARATIONS***************************************Option ExplicitOption Base 1Dim thisDrawing As AcadDocumentDim arLayer() As String' *********************************************************************************Sub LayerStatus2txt() Dim ssLayerEnt As BricscadApp.AcadSelectionSet Dim ssEnt As bricscaddb.AcadEntity Dim fName As String, fNum As Integer, i As Integer Dim ssLayer As bricscaddb.AcadLayer, strStatus As String Set thisDrawing = ActiveDocument: i = 0 Set ssLayerEnt = thisDrawing.ActiveSelectionSet: ssLayerEnt.Clear ssLayerEnt.Select acSelectionSetAll For Each ssLayer In thisDrawing.Layers strStatus = "": i = i + 1 ReDim Preserve arLayer(1 To i) arLayer(i) = ssLayer.Name & Chr(10) If CBool(ssLayer.LayerOn) = True Then strStatus = " On" Else strStatus = "Off" arLayer(i) = arLayer(i) & " " & strStatus If CBool(ssLayer.Lock) = True Then strStatus = " Locked" Else strStatus = "UnLocked" arLayer(i) = arLayer(i) & " " & strStatus If CBool(ssLayer.Freeze) = True Then strStatus = "Frozen" Else strStatus = "Thawed" arLayer(i) = arLayer(i) & " " & strStatus arLayer(i) = arLayer(i) & " " & VBA.Left(" ", 4 - VBA.Len(VBA.CStr(ssLayer.Color))) & ssLayer.Color arLayer(i) = arLayer(i) & " " & VBA.Left(" ", 4 - VBA.Len(VBA.CStr(ssLayer.Lineweight))) & ssLayer.Lineweight arLayer(i) = arLayer(i) & " " & VBA.Left(" ", 15 - VBA.Len(VBA.CStr(ssLayer.Linetype))) & ssLayer.Linetype Next Call sortStr(LBound(arLayer) + 1, UBound(arLayer), arLayer) Set ssLayerEnt = Nothing Set ssEnt = Nothing If thisDrawing.Path = "" Then fName = "c:\" & thisDrawing.Name & ".layerstatus.txt" Else fName = thisDrawing.Path & "\" & thisDrawing.Name & ".layerstatus.txt" End If fNum = 2 Open fName For Output Access Write As #fNum Print #fNum, thisDrawing.Name Print #fNum, VBA.Date Print #fNum, Print #fNum, "LayerName" Print #fNum, " On/- Locked/- Frozen/- Color LineWeight LineType" Print #fNum, For i = 1 To UBound(arLayer) Print #fNum, arLayer(i) Next i Close #fNum Dim showtxt showtxt = Shell("notepad.exe " & fName, vbNormalFocus) AppActivate showtxtEnd Sub' *********************************************************************************Public Sub sortStr(intLB As Integer, intUB As Integer, arrayText() As String) Dim intOut As Integer Dim intIn As Integer Dim strRepl As String For intOut = intLB To (intUB - 1) For intIn = (intOut + 1) To intUB If StrComp(arrayText(intIn), arrayText(intOut), vbTextCompare) = -1 Then strRepl = arrayText(intIn) arrayText(intIn) = arrayText(intOut) arrayText(intOut) = strRepl End If Next NextEnd Sub' *********************************************************************************
0 -
The uploaded code is not perfect, for all alignment that I created by multiple spaces is stripped. I can send it to anyone interested.
0 -
I inquired the ability to use AcadLayerManagerState which is supposed to be the class to access thru VBA in V8. The example code for AUTOCAD is fairly simple and would make many layer manipulations very easy. From the nonresponse I've received I assume that the actual class is nil. If someone at Bricscad could confirm that this is the case or not, please respond.
0