|
The Code
Function GetLayerFile() As String
Dim dbPref As AecArchBaseDatabasePreferences
Set dbPref = AecArchBaseApplication.ActiveDocument.Preferences
GetLayerFile = dbPref.LayerFile
End Function
Sub SetLayerFile(fn As String)
Dim dbPref As AecArchBaseDatabasePreferences
Set dbPref = AecArchBaseApplication.ActiveDocument.Preferences
If Dir(fn) <> "" Then dbPref.LayerFile = fn
End Sub
Function GetLayerStandard() As String
Dim dbPref As AecArchBaseDatabasePreferences
Set dbPref = AecArchBaseApplication.ActiveDocument.Preferences
GetLayerStandard = dbPref.LayerStandard
End Function
Sub ImportLayerKey(dwgName As String, keyName As String)
Dim cmdString As String
ThisDrawing.Utility.Prompt vbCrLf & "Importing Layer Key <" & keyName & "> from " & dwgName
dwgName = Join(Split(dwgName, "\", , 1), "/")
cmdString = "(AecImportLayerKeyingStyle " & Chr(34) & dwgName & Chr(34) & _
" " & Chr(34) & keyName & Chr(34) & ") "
ThisDrawing.SendCommand cmdString
End Sub
Sub SetLayerStandard(ByVal LyrStd As String)
Dim dbPref As AecArchBaseDatabasePreferences
Set dbPref = AecArchBaseApplication.ActiveDocument.Preferences
dbPref.LayerStandard = LyrStd
End Sub
Function GetLayerKeyStyles(Optional dwg As AcadDocument) As Variant
Dim db As New AecBaseDatabase, LyrKeyStyle As AecLayerKeyStyle, keys() As String, cnt As Long
If dwg Is Nothing Then
db.Init ThisDrawing.Database
Else
db.Init dwg.Database
End If
cnt = 0
For Each LyrKeyStyle In db.LayerKeyStyles
ReDim Preserve keys(cnt)
keys(cnt) = LyrKeyStyle.Name
cnt = cnt + 1
Next
GetLayerKeyStyles = keys
End Function
Function GetLayerKeys(ByVal lyrKeyStyleName As String) As Variant
Dim lKey As AecLayerKey, db As New AecBaseDatabase, cnt As Long, key() As String
db.Init ThisDrawing.Database
cnt = 0
For Each lKey In db.LayerKeyStyles(lyrKeyStyleName).keys
ReDim Preserve key(cnt)
key(cnt) = lKey.Name
cnt = cnt + 1
Next
GetLayerKeys = key
End Function
Function GetLayerKey(ByVal lyrKeyStyleName As String, ByVal kName As String) As AecLayerKey
Dim lKey As AecLayerKey, db As New AecBaseDatabase
db.Init ThisDrawing.Database
Set GetLayerKey = db.LayerKeyStyles(lyrKeyStyleName).keys(kName)
End Function
Function CreateLayerFromKey(ByVal lyrKeyStyleName As String, ByVal kName As String) As String
Dim lKey As AecLayerKey, db As New AecBaseDatabase
db.Init ThisDrawing.Database
On Error GoTo errCheck
CreateLayerFromKey = db.LayerKeyStyles(lyrKeyStyleName).GenerateLayer(kName).Name
Exit Function
errCheck:
ThisDrawing.Utility.Prompt vbCrLf & "The layer key <" & kName & _
"> does not exist in the keystyle <" & lyrKeyStyleName & ">!"
CreateLayerFromKey = ""
End Function
Function GetLayerOverrideSettings() As Variant
Dim CurrlKey As String, ovr As AecLayerOverrideSetting, db As New AecBaseDatabase, cnt As Long, ov() As String
db.Init ThisDrawing.Database
CurrlKey = Layer.GetLayerStandard
cnt = 0
On Error GoTo errTrap
If db.LayerKeyStyles(CurrlKey).OverrideSettings.Count > 0 Then
For Each ovr In db.LayerKeyStyles(CurrlKey).OverrideSettings
ReDim Preserve ov(cnt)
ov(cnt) = ovr.Name & ":" & ovr.Value
Next
End If
GetLayerOverrideSettings = ov
errTrap:
End Function
Function GetLayerOverrideState() As Boolean
Dim CurrlKey As String, db As New AecBaseDatabase
db.Init ThisDrawing.Database
CurrlKey = Layer.GetLayerStandard
GetLayerOverrideState = db.LayerKeyStyles(CurrlKey).OverridesEnabled
End Function
Sub SetLayerOverrideState(flag As Boolean)
Dim CurrlKey As String, db As New AecBaseDatabase
db.Init ThisDrawing.Database
CurrlKey = Layer.GetLayerStandard
db.LayerKeyStyles(CurrlKey).OverridesEnabled = flag
End Sub
| 
