How to activate textstyle programmatically(like after key-in:textstyle active "Tahoma_03_LT") which is from attached library(TextStyle.IsFromLibrary )?
Dim txsp As TextStyle Set txst = ActiveDesignFile.TextStyles.Add(Nothing, "Tahoma_03_LT") Set txst = ActiveDesignFile.TextStyles.Find("Tahoma_03_LT") txsp.UsesColor = False
This gives "unknown error". If comment out "Set txst = ActiveDesignFile.TextStyles.Add(Nothing, "Tahoma_03_LT")" then I get "run-time error 2147221504 (80040000): The TextStyle is locked and cannot be modified." which is not a surprise as textstyle in dgnlib can't be modified. I need to change usescolor flag as workaround to Defect 668134.
This article may provide a clue.
Regards, Jon Summers LA Solutions
Modify the function in the article I cited. The existing MDL function gets a C pointer to the text style. The following MDL function adds a new text style to the active DGN file...
Declare Function mdlTextStyle_addToFile Lib "stdmdlbltin.dll" ( _ ByRef pNewTableEntryId As Long , _ ByVal pStyle As Long , _ ByVal pStyleName As Long , _ ByVal bLockEntry As Long ) As Long
The second argument, pStyle, is the pointer styleAddress you got from the first MDL function. Here's what the complete function might look like (untested code)...
Public Function AddTextStyle(ByVal name As String, ByVal searchLibs As Boolean) As Boolean AddTextStyle = False Dim styleAddress As Long Dim styleIdAddress As Long styleIdAddress = -1 If (SUCCESS = mdlTextStyle_getByName( _ styleAddress, styleIdAddress, StrPtr(name), _ ActiveModelReference.MdlModelRefP, searchLibs)) Then Dim newId As Long Const LockEntry As Long = 0 ' No idea what that does! AddTextStyle = (SUCCESS = mdlTextStyle_addToFile ( _ newId, styleAddress, name, LockEntry) End Function
Unknown said: Const LockEntry As Long = 0 ' No idea what that does! AddTextStyle = (SUCCESS = mdlTextStyle_addToFile ( _ newId, styleAddress, name, LockEntry)
Const
LockEntry
As
Long
= 0
' No idea what that does!
AddTextStyle = (SUCCESS = mdlTextStyle_addToFile ( _
newId, styleAddress, name, LockEntry)
FYI. This was used in MicroStation V8 to get/set the locked flag in the element header.
Unknown said:
#If VBA7 Then Private Declare PtrSafe Function mdlTextStyle_addToFile Lib "stdmdlbltin.dll" ( _ ByRef pNewTableEntryId As Long, _ ByVal pStyle As Long, _ ByVal pStyleName As LongPtr, _ ByVal bLockEntry As Long) As Long Private Declare PtrSafe Function mdlTextStyle_getByName Lib "stdmdlbltin.dll" ( _ ByRef pStyle As Long, _ ByRef pTextStyleId As Long, _ ByVal pStyleName As LongPtr, _ ByVal modelRef As LongPtr, _ ByVal SearchLibrary As Long) As Long #Else Declare Function mdlTextStyle_addToFile Lib "stdmdlbltin.dll" ( _ ByRef pNewTableEntryId As Long, _ ByVal pStyle As Long, _ ByVal pStyleName As Long, _ ByVal bLockEntry As Long) As Long Declare Function mdlTextStyle_getByName Lib "stdmdlbltin.dll" ( _ ByRef pStyle As Long, _ ByRef pTextStyleId As Long, _ ByVal pStyleName As Long, _ ByVal modelRef As Long, _ ByVal SearchLibrary As Long) As Long #End If
Some minor typos but function works almost as expected
Public Function AddTextStyle(ByVal name As String, ByVal searchLibs As Boolean) As Boolean AddTextStyle = False Dim styleAddress As Long Dim styleIdAddress As Long styleIdAddress = -1 If (SUCCESS = mdlTextStyle_getByName( _ styleAddress, styleIdAddress, StrPtr(name), _ ActiveModelReference.MdlModelRefP, searchLibs)) Then Dim newId As Long Const LockEntry As Long = 0 ' No idea what that does! AddTextStyle = (SUCCESS = mdlTextStyle_addToFile( _ newId, styleAddress, StrPtr(name), LockEntry)) End If End Function
Only issue that style is copied not activated from dgnlib so "Update from library" option is greyed out. Does the LockEntry sets that it is linked from library?
And how to remove this lock flag if it is set? The keyin "textstyle unlock [textstyle_name]" doesn't apply to MS V8i >SS3. Returns "Unknown key-in or command."And how to set flag that style is copied from library?