TheSwamp
Code Red => VB(A) => Topic started by: Matersammichman on September 07, 2006, 12:08:44 PM
-
I have a named LayerState (Temp).
How can I make vba delete this?
-
i dont think you can. From what I remember, LayerStates are not exposed to VBA
-
You can automate it via the command line.
You can bring up the layer manager, then sendkeys, the letter "r" will open the state manager.
Once inside tere you can access the commands with alt and sndkeys, as the letters are underlined.
Should work.
-
Here is how I got a list of them in lisp (ActiveX) which I think you can make into VBA pretty easliy
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq LayCol (vla-get-Layers ActDoc))
(setq LayDict (vla-GetExtensionDictionary LayCol))
(setq LayStDict (vl-catch-all-apply 'vla-Item (list LayDict "ACAD_LAYERSTATES")))
If 'LayStDict' isn't an error, then you have layer states in the current drawing. Hope that helps.
-
Quick stab at the command line one:
Public Sub DeleteLaterStateTemp()
ThisDrawing.SendCommand "-layer" & vbCr
ThisDrawing.SendCommand "a" & vbCr
ThisDrawing.SendCommand "d" & vbCr
ThisDrawing.SendCommand "temp" & vbCr & vbCr & vbCr
End Sub
-
This seems to work in v2004. Maybe it will help
Public Sub DelLayerState()
Dim colLayers As AcadLayers
Dim objDict As AcadDictionary
Dim objLayerStates As AcadDictionary
Dim objXrec As AcadXRecord
Set colLayers = Me.Layers
If colLayers.HasExtensionDictionary Then
Set objDict = colLayers.GetExtensionDictionary
Set objLayerStates = objDict("Acad_LayerStates")
objLayerStates("temp").Delete
End If
End Sub
Needs more error checking and hasn't been fully tested
-
Nice!
-
Dave,
Thanks for the help, but... Vba choked on "Me.Layers"
ideas?
-
Try
ThisDrawing.Layers
-
Worked beautifully!
Thanks!
-
Learn something everyday!!!
-
So my question is can you create a layerstate through code?
-
Look into the LayerStateManager object.......saves from having to mess with Dictionaries, it does all the work for you.
-
I cant get the delete part to work in 07
Public Sub DelLayerState()
Dim colLayers As AcadLayers
Dim objDict As AcadDictionary
Dim objLayerStates As AcadDictionary
Dim objXrec As AcadXRecord
Set colLayers = ThisDrawing.Layers
If colLayers.HasExtensionDictionary Then
Set objDict = colLayers.GetExtensionDictionary
Set objLayerStates = objDict("ACAD_LAYERFILTERS")
objLayerStates("adf").Delete
End If
End Sub
-
How do I find that?
-
How do I find that?
In the help, developers guide, VBA ActiveX reference, objects, LayerStateManager
-
Here's a quick example for 2007:
Sub LS_test()
Dim oLSM As AcadLayerStateManager
Set oLSM = ThisDrawing.Application. _
GetInterfaceObject("AutoCAD.AcadLayerStateManager.17")
oLSM.SetDatabase ThisDrawing.Database
On Error Resume Next
oLSM.Delete "abcd"
If Err Then
MsgBox "Layerstate not found...."
Err.Clear
Else
ThisDrawing.Utility.Prompt vbCr & "Layerstate {abcd} deleted."
End If
End Sub
-
Thanks Jeff. I haven't used the ThisDrawing.Application area much. I need to explore that area.
T.W. - does it tell you where its found in code? (I haven't looked it up yet) Looking in the developer guide is great only if it tells you where to find it in the IDE
-
You guys have been such a great help to me, let me share this.
What I wanted to do was create a LayerState named "Temp" that I could save, and overwrite as needed. Here is the completed blurb of code in ADT2005)
Private Sub cmdTLS_Click()
On Error Resume Next
Dim colLayers As AcadLayers
Dim objDict As AcadDictionary
Dim objLayerStates As AcadDictionary
Dim objXrec As AcadXRecord
Set colLayers = ThisDrawing.Layers
If colLayers.HasExtensionDictionary Then
Set objDict = colLayers.GetExtensionDictionary
Set objLayerStates = objDict("Acad_LayerStates")
objLayerStates("temp").Delete
End If
'''
Dim oLSM As AcadLayerStateManager
' Access the LayerStateManager object
Set oLSM = ThisDrawing.Application. _
GetInterfaceObject("AutoCAD.AcadLayerStateManager.16")
' Associate the current drawing database with LayerStateManager
oLSM.SetDatabase ThisDrawing.Database
oLSM.Save "Temp", acLsOn + acLsFrozen + acLsLocked
Me.hide
End Sub