Would you like to save different layer states in IntelliCAD? I put this together, not the best piece of code but it works. It will save layer states to a text file in the drawing directory. It retrieve said states when picked from a list box. The funny thing is it will not work on the default ICAD drawing (when ICAD is initially open)-- the command Document.Path does not get this default drawing Path (strange), works if the drawing has been saved.

I did not find a way to access viewport layer states, any ideas??

Comments are encouraged and welcome.

You will need a form with the following:
listbox lboDrawingLayers
listbox lboRestoreState
Button cmdOK
Button cmdCancel
Button cmdLayerStateSave

Code follows (sorry for the length could be smaller):

'Created By Scott Campbell
'03/29/01
'Layer States for IntelliCAD 2000

Option Explicit
Dim objlayer As Layer
Dim mydoc As Document
Dim mydocname As String
Dim myarray As Variant
Dim mypath As String
Dim viewports As WhichViewport
Dim mylayers As Layers
Dim mylayer As Layer
Dim fchkflag As Boolean
Dim mystring As String

Private Sub UserForm_Initialize()

Set mydoc = intellicad.ActiveDocument
Set mylayers = mydoc.Layers

mydocname = VBA.Replace(mydoc.Name, VBA.Chr(46), "") & "-LS" & ".txt" 'replace period with nothing
mypath = mydoc.Path & "\" & mydocname 'create file path

For Each objlayer In intellicad.ActiveDocument.Layers
lboDrawingLayers.AddItem objlayer.Name 'add them to the list box

Next
currentlayerstates
loadstates

End Sub

Sub loadstates()

Dim stemp As String
Dim myarray As Variant

lboRestoreState.Clear 'clear the listbox

filechk

If fchkflag = True Then
mydocname = VBA.Replace(mydoc.Name, VBA.Chr(46), "") & "-LS" & ".txt" 'replace period with nothing
mypath = mydoc.Path & "\" & mydocname 'create file path

Open mypath For Input As #1

While Not EOF(1)

Line Input #1, stemp
myarray = Split(stemp, ",")
If myarray(0) = mystring Then

Else
lboRestoreState.AddItem myarray(0)
End If

mystring = myarray(0)
Wend

Close #1 'close the file
Else
End If

End Sub

Private Sub filechk()

Dim myfolder As String
Dim fs, f, f1, fc, s

myfolder = mydoc.Path 'create file path
mydocname = VBA.Replace(mydoc.Name, VBA.Chr(46), "") & "-LS" & ".txt" 'replace period with nothing

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(myfolder)
Set fc = f.Files
For Each f1 In fc

If f1.Name = mydocname Then
fchkflag = True
Else
End If
Next

End Sub


Sub cmdLayerStateSave_Click()

Dim Message, Title, Default, myvalue

Message = "Enter Layer State Description" ' Set prompt
Title = "Save Layer State" ' Set title
Default = "Original" ' Set default

mydocname = VBA.Replace(mydoc.Name, VBA.Chr(46), "") & "-LS" & ".txt" 'replace period with nothing
mypath = mydoc.Path & "\" & mydocname 'create file path

mystring = InputBox(Message, Title, Default)

If mystring = "" Then 'checks for cancel in inputbox
cmdCancel_Click
Else
End If

Open mypath For Append As #1 'open text file

savelayers

Unload Me 'unload dialogue

End Sub

Private Sub cmdOK_Click()

mystring = "Cancel"
mydocname = VBA.Replace(mydoc.Name, VBA.Chr(46), "") & mystring & ".txt" 'replace period with nothing
mypath = mydoc.Path & "\" & mydocname 'open cancel file storing states prior to procedure

Kill mypath 'deletes existing layer state txt file on exit

End
End Sub

Sub cmdCancel_Click()
Dim mycancelpath As String
Dim mycancelname As String

mystring = "Cancel"
mydocname = VBA.Replace(mydoc.Name, VBA.Chr(46), "") & mystring & ".txt" 'replace period with nothing
mypath = mydoc.Path & "\" & mydocname 'open cancel file storing states prior to procedure

Open mypath For Input As #1
restorelayers 'restores layer state prior to initiating procedure
Kill mypath 'deletes existing layer state txt file on exit

End
End Sub

Sub lboRestoreState_Click()
Dim stemp As String
Dim rlayer As Variant
Dim rfreeze As Variant
Dim ron As Variant
Dim rlock As Variant

mystring = lboRestoreState.Value

mydocname = VBA.Replace(mydoc.Name, VBA.Chr(46), "") & "-LS" & ".txt" 'replace period with nothing
mypath = mydoc.Path & "\" & mydocname 'create file path

Open mypath For Input As #1
restorelayers

End Sub

Private Sub currentlayerstates()
Dim mycancelpath As String
Dim mycancelname As String
Dim lname As String
Dim stemp As String
Dim rlayer As Variant
Dim rfreeze As Variant
Dim ron As Variant
Dim rlock As Variant

mystring = "Cancel"
mycancelname = VBA.Replace(mydoc.Name, VBA.Chr(46), "") & mystring & ".txt" 'replace period with nothing
mypath = mydoc.Path & "\" & mycancelname 'create file path

Open mypath For Output As #1 'open text file
savelayers

End Sub

Private Sub savelayers()
Dim lname As String
Dim lfreeze As Variant
Dim loff As Variant
Dim llock As Variant

For Each objlayer In intellicad.ActiveDocument.Layers 'start looping thru' the layer names
lname = objlayer.Name

If objlayer.Freeze = True Then
lfreeze = "Frozen"
Else
lfreeze = "Thawed"
End If

If objlayer.LayerOn = True Then
loff = "on"
Else
loff = "off"
End If

If objlayer.Lock = True Then
llock = "locked"
Else
llock = "unlocked"
End If

Print #1, mystring & "," & lname & "," & lfreeze & "," & loff & "," & llock 'print it to the file

Next

Close #1 'close the file

End Sub
Private Sub restorelayers()
Dim stemp As String
Dim rlayer As Variant
Dim rfreeze As Variant
Dim ron As Variant
Dim rlock As Variant

While Not EOF(1)
Line Input #1, stemp
myarray = Split(stemp, ",")
If myarray(0) = mystring Then
rlayer = myarray(1)
Set mylayer = mylayers.Item(rlayer)
rfreeze = myarray(2)

If rfreeze = "Thawed" Then
mylayer.Freeze = False
Else
mylayer.Freeze = True
End If

ron = myarray(3)
If ron = "on" Then
mylayer.LayerOn = True
Else
mylayer.LayerOn = False
End If

rlock = myarray(4)
If rlock = "locked" Then
mylayer.Lock = True
Else
mylayer.Lock = False
End If

Else
End If
Wend

Close #1 'close the file

viewports = vicActiveViewport
intellicad.ActiveDocument.Regen ([viewports])

End Sub

'End Code

Scott

Thanks Scott,

I look forward to giving this a try.

Melodie