I am working on a script which will replace existing cells on a drawing with an updated version from our cell library. This is being done because of a driver from our customer to have certain cell symbology match those utilized in other documentation. I need to automate this because we are updating close to 3000 drawings, each of which has an average of 50-100 cells which will be affected.
The simple answer is to "replace" the cell. Unfortunately that can't work by itself because we have many cells which have pre-designated text areas, such as component names/identifiers and pin numbers, defined for use by the worker. A simple "Replace" of the cell will get rid of the text that was added to the cells.
To make matters worse, sometimes the text will not fit on a single line in the designated area, so it becomes a text node. This is where I am having difficulty.
Currently I have the code listed below working to do everything I need. Sorry if it is a bit long, and probably more convoluted than it needs to be. I generally start by writing code "off the cuff" to make it work, then refine and optimize it later.
My code is copying the text and/or nodes properly, and replacing the information into the cells once the cell has been replaced. It has been very difficult and frustrating, but I currently have all of the text and nodes in the correct format (font, sizes, justification, color, etc) with one notable exception.
Every text node has an error in the intercharacter spacing when it is replaced. The initial value for the intercharacter spacing in a cell is generally set to the same value as the text width. However, after the cell is replaced, when the node is copied back into it, the intercharacter spacing is set to 0.0002 instead of the pre-existing value. This is casuing all the characters on a line to be overlapped/stacked on top of each other.
What I need is help in determining how to read the current intercharacter spacing and then assign that value to the replaced text node. I don't know why the value isn't being copied with the rest of the text style settings. I also do not know why it is set to 0.0002 on every item I test, regardless of the original text or node's spacing. My edit text attributes tool is almost always set to 0.2, if that helps in any way.
I recently considered simply editing the text attributes after the fact, but am only able to find references for turning the intercharacter spacing checkbox on/off and nothing regarding how to set the value in VBA. I assume it would be via a "tcb->" value or something similar, but have not been able to find a good reference for one.
Any help would be greatly appreciated.
Option Explicit ' Stores the name of the border and design file Dim borderName As String, dgnName As String ' Stores the revision letter of the diagram file Dim revLetter As String ' Stores the border size number (5-12) Dim borderSize As Integer ' Standard number variables for manipulation Dim strLength As Integer, X As Integer ' Standard coordinate use Dim startPoint As Point3d, endPoint As Point3d ' Reference coordinates for placing items like cells and text Dim dropPoint As Point3d ' Array used to store all corner coordinates of the current fence for future reference Dim fencePoints() As Point3d ' Procedure to handle Modal windows, used simply to close them automatically when actions complete Dim modalHandle As New ModalHandler ' Pointer to a profile for searches/manipulation Dim scanCriteria As New ElementScanCriteria ' Pointer to an element value Dim enumerator As ElementEnumerator ' Pointers to current element or for making a duplicate element for manipulation Dim ele As Element, cellCopy As Element ' Pointer to an element contained within the current cell Dim cellEle As CellElement ' Value used for tracking what heirarchal level of a cell we are in Dim nestLevel As Long ' True or False value for determining if a text/node has not data Dim isBlank As Boolean ' For general troubleshooting and message boxes Dim Response As String ' For text format manipulation Dim textElem As TextElement
Sub UpdateCells(cellName As String, cellLibrary As String, fenceStartPoint As Point3d, fenceEndPoint As Point3d, cellStartPoint As Point3d) ' This is used to update existing cells in the drawing with newer versions.' If the cell includes text or text nodes, it will copy the text information' before updating the cell, to maintain user specified data. After the cell' has been replaced, the text will be copied back into the cell using the' current cells text styles to ensure everything looks right.'' This is currently only used for specific cells which are in known/designated' locations, such as the initials, signatures, dates, revision statements and' function blocks. Other cells will be addressed later, using their current locations.'' No block of any cell can have more than 4 lines of text, by drawing design' standards, and no cell has more than 15 text/node points.
Dim cellExists As BooleanDim nodeCounter As IntegerDim nodeArray(15, 4) As StringDim firstElement As LongDim XLine As Long
cellExists = FalsenodeCounter = 0For X = 1 To 15 nodeArray(X, 1) = vbNullString nodeArray(X, 2) = vbNullString nodeArray(X, 3) = vbNullString nodeArray(X, 4) = vbNullStringNext X
' Attach cell library and set active cell CadInputQueue.SendCommand "RC=C:\Documents and Settings\All Users\Application Data\Bentley\WorkSpace\System\OFD2\CELL\" + cellLibrary + ".cel" CadInputQueue.SendCommand "AC=" + cellName ' Select by cell name scanCriteria.IncludeOnlyCell cellName scanCriteria.ExcludeAllTypes scanCriteria.IncludeType msdElementTypeSharedCell scanCriteria.IncludeType msdElementTypeCellHeader ' Setup Scan Memory Set enumerator = ActiveModelReference.Scan(scanCriteria) ShowStatus "Updating elements" ' Step through the scan results Do While enumerator.MoveNext With enumerator.Current ' Copy all text items in the cell. ' This is needed for the Functions cell, which should have function names ' filled in if this is a revision to the drawing. ' Start by walking through the cell components nestLevel = 0 Set cellEle = enumerator.Current Do While cellEle.MoveToNextElement(True, nestLevel) If Not cellExists Then ' Now that we found it make sure we know it cellExists = True End If ' Make a working copy of the element to manipulate data Set cellCopy = cellEle.CopyCurrentElement ' Check to see if it is a text node (all text items in the cell should be) If cellCopy.IsTextNodeElement Then ' Update the node count nodeCounter = nodeCounter + 1 ' Set up to copy all the lines to an array For XLine = 1 To cellCopy.AsTextNodeElement.TextLinesCount ' Copy the line to our array nodeArray(nodeCounter, XLine) = cellCopy.AsTextNodeElement.TextLine(XLine) Next XLine End If Loop End With Loop ' OK, cell text nodes are stored in an arry so now we can replace the cell. ' This code will delete the cell area and put a new cell in place, regardless ' of whether one exists or not, and regardless of the cell being dropped. ' Set Fence placement selection to Block and select the tool SetCExpressionValue "tcb->msToolSettings.fence.placeMode", 0, "" CadInputQueue.SendCommand "PLACE FENCE ICON"
' Send a data points to the fence tool CadInputQueue.SendDataPoint fenceStartPoint, 1 CadInputQueue.SendDataPoint fenceEndPoint, 1 ' Set Delete Fence Contents selection to Inside and select the tool CadInputQueue.SendCommand "FENCE DELETE" CadInputQueue.SendCommand "LOCK FENCE INSIDE" ' Send data point to the Delete Fence Contents tool. ' This deletes anything from that particular area, since ' the only thing that should be in there is the cell we want CadInputQueue.SendDataPoint fenceStartPoint, 1 ' Place active cell CadInputQueue.SendCommand "PLACE CELL ICON" CadInputQueue.SendDataPoint cellStartPoint, 1 ' Clear selections and return to default controls DrawingSetup.SetupControls ActiveModelReference.UnselectAllElements
nodeCounter = 0 scanCriteria.Reset ' Select by cell name scanCriteria.IncludeOnlyCell cellName scanCriteria.ExcludeAllTypes scanCriteria.IncludeType msdElementTypeSharedCell scanCriteria.IncludeType msdElementTypeCellHeader ' Setup Scan Memory Set enumerator = ActiveModelReference.Scan(scanCriteria) ShowStatus "Updating elements" ' Step through the scan results Do While enumerator.MoveNext With enumerator.Current Set cellEle = enumerator.Current ' And now, we paste information back into the cell, from the array, if needed Do While cellEle.MoveToNextElement(True, nestLevel) Set cellCopy = cellEle.CopyCurrentElement If cellCopy.IsTextNodeElement Then Dim nodeTemplate As TextElement Dim haveTemplate As Boolean haveTemplate = False Dim textEnum As ElementEnumerator Set textEnum = cellCopy.AsTextNodeElement.GetSubElements Do While (textEnum.MoveNext) With textEnum.Current If textEnum.Current.IsTextElement And Not haveTemplate Then Set nodeTemplate = textEnum.Current haveTemplate = True End If End With Loop nodeCounter = nodeCounter + 1 Dim tempNode As TextNodeElement Set tempNode = CreateTextNodeElement2(cellCopy.AsTextNodeElement, cellCopy.AsTextNodeElement.Origin, Matrix3dIdentity) cellEle.Redraw msdDrawingModeErase ' Max number of lines in the area should be 4, so we will limit the checks to that For XLine = 1 To 4 If nodeArray(nodeCounter, XLine) <> vbNullString Then tempNode.AddTextLine nodeArray(nodeCounter, XLine) End If Next XLine
Set textEnum = tempNode.GetSubElements Do While (textEnum.MoveNext) Dim textComp As Element Dim nodeICS As Double Set textComp = textEnum.Current Set textComp.AsTextElement.TextStyle = nodeTemplate.TextStyle textComp.Redraw Loop tempNode.Redraw cellEle.AsCellElement.ReplaceCurrentElement tempNode cellEle.Redraw cellEle.Rewrite ' And now we just need to fix the stupid inter character spacing bug issue CadInputQueue.SendCommand "MODIFY TEXT"
' *** This is my latest attempt to fix the problem...
' Set a variable associated with a dialog box SetCExpressionValue "tcb->msToolSettings.changeText.textstyle", 0, "MODIFY" SetCExpressionValue "tcb->msToolSettings.changeText.font", 0, "MODIFY" SetCExpressionValue "tcb->msToolSettings.changeText.height", 0, "MODIFY" SetCExpressionValue "tcb->msToolSettings.changeText.width", 0, "MODIFY" SetCExpressionValue "tcb->msToolSettings.changeText.linespace", 0, "MODIFY" SetCExpressionValue "tcb->msToolSettings.changeText.linespacetype", 0, "MODIFY" SetCExpressionValue "tcb->msToolSettings.changeText.interchar", 1, "MODIFY" SetCExpressionValue "tcb->msToolSettings.changeText.slant", 0, "MODIFY" SetCExpressionValue "tcb->msToolSettings.changeText.linelength", 0, "MODIFY" SetCExpressionValue "tcb->msToolSettings.changeText.underline", 0, "MODIFY" SetCExpressionValue "tcb->msToolSettings.changeText.vertical", 0, "MODIFY" SetCExpressionValue "tcb->msToolSettings.changeText.viewind", 0, "MODIFY" SetCExpressionValue "tcb->msToolSettings.changeText.just", 0, "MODIFY" SetCExpressionValue "gUseChangeAnnotationScale", 0, "MODIFY"
CadInputQueue.SendDataPoint cellStartPoint, 1
' *** ...but I can't find a code to use for setting the intercharacter spacing value.
' Send a reset to the current command CadInputQueue.SendReset
CommandState.StartDefaultCommand End If Loop End With Loop If Not cellExists Then ' Set Fence placement selection to Block and select the tool SetCExpressionValue "tcb->msToolSettings.fence.placeMode", 0, "" CadInputQueue.SendCommand "PLACE FENCE ICON"
' Send a data points to the fence tool CadInputQueue.SendDataPoint fenceStartPoint, 1 CadInputQueue.SendDataPoint fenceEndPoint, 1 ' Set Delete Fence Contents selection to Inside and select the tool CadInputQueue.SendCommand "FENCE DELETE" CadInputQueue.SendCommand "LOCK FENCE INSIDE" ' Send data point to the Delete Fence Contents tool. ' This deletes anything from that particular area, since ' the only thing that should be in there is the cell we want CadInputQueue.SendDataPoint fenceStartPoint, 1 ' Place active cell CadInputQueue.SendCommand "PLACE CELL ICON" CadInputQueue.SendDataPoint cellStartPoint, 1 End If ' Clear selections and return to default controls DrawingSetup.SetupControls
ActiveModelReference.UnselectAllElements
End Sub
**** Originally posted in the wrong forum ****
Look in the ActiveSettings.TextStyle object. It has an InterCharacterSpacing property.
Regards, Jon Summers LA Solutions
Yeah, that will set the active setting, which will work for any new text, but doesn't seem to work when copying.
I also used the .AsTextElement.TextStyle.InterCharacterSpacing to set each line of text in the node individually. This value was accepted, as I can post the value in a message box, but it makes no difference to the final output.
Something I find very interesting is that you can not see the intercharacter spacing value when you select an object and look at it's info window. There is a line for line spacing, but not for this. Really weird.
Since none of the .textstyle settings seem to work, I think the only option left is to apply a Change Text Attribute tool on the cell after everything else is done. I know that this works, by doing it manually, but I can't get it to work with code.
This turns the intercharacter setting for that tool on/off:
SetCExpressionValue "tcb->msToolSettings.changeText.interchar", 1, "MODIFY"
Does anyone know what needs to be done to actually set the value for that tool?
You may have bumped against VBA's Temporary Objects problem. This is discussed in VBA Help.
The problem is that when you do something like this …
.AsTextElement.TextStyle.InterCharacterSpacing = 1.234
VBA creates a temporary anonymous copy of the object (in this example, a TextStyle). The assignment modifies that temporary copy, which is then discarded, so the original you thought you were modifying remains unaltered. Try something like this instead …
Dim oStyle As TextStyle Set oStyle = .AsTextElement.TextStyle oStyle.InterCharacterSpacing = 1.234 Set .AsTextElement.TextStyle = oStyle
Jon,
Thanks for the idea.
I tried it out, but it is still giving me the same results.
(Updated code...)
Sub UpdateCells(cellName As String, cellLibrary As String, fenceStartPoint As Point3d, fenceEndPoint As Point3d, cellStartPoint As Point3d)
Dim cellExists As Boolean
Dim nodeCounter As Integer
Dim nodeArray(15, 4) As String
Dim firstElement As Long
Dim XLine As Long
Dim oStyle As TextStyle
cellExists = False
nodeCounter = 0
For X = 1 To 15
nodeArray(X, 1) = vbNullString
nodeArray(X, 2) = vbNullString
nodeArray(X, 3) = vbNullString
nodeArray(X, 4) = vbNullString
Next X
' Attach cell library and set active cell
CadInputQueue.SendCommand "RC=C:\Documents and Settings\All Users\Application Data\Bentley\WorkSpace\System\OFD2\CELL\" + cellLibrary + ".cel"
CadInputQueue.SendCommand "AC=" + cellName
' Select by cell name
scanCriteria.IncludeOnlyCell cellName
scanCriteria.ExcludeAllTypes
scanCriteria.IncludeType msdElementTypeSharedCell
scanCriteria.IncludeType msdElementTypeCellHeader
' Setup Scan Memory
Set enumerator = ActiveModelReference.Scan(scanCriteria)
ShowStatus "Updating elements"
' Step through the scan results
Do While enumerator.MoveNext
With enumerator.Current
' Copy all text items in the cell.
' This is needed for the Functions cell, which should have function names
' filled in if this is a revision to the drawing.
' Start by walking through the cell components
nestLevel = 0
Set cellEle = enumerator.Current
Do While cellEle.MoveToNextElement(True, nestLevel)
If Not cellExists Then
' Now that we found it make sure we know it
cellExists = True
End If
' Make a working copy of the element to manipulate data
Set cellCopy = cellEle.CopyCurrentElement
' Check to see if it is a text node (all text items in the cell should be)
If cellCopy.IsTextNodeElement Then
' Update the node count
nodeCounter = nodeCounter + 1
' Set up to copy all the lines to an array
For XLine = 1 To cellCopy.AsTextNodeElement.TextLinesCount
' Copy the line to our array
nodeArray(nodeCounter, XLine) = cellCopy.AsTextNodeElement.TextLine(XLine)
Next XLine
Loop
End With
' OK, cell text nodes are stored in an arry so now we can replace the cell.
' This code will delete the cell area and put a new cell in place, regardless
' of whether one exists or not, and regardless of the cell being dropped.
' Set Fence placement selection to Block and select the tool
SetCExpressionValue "tcb->msToolSettings.fence.placeMode", 0, ""
CadInputQueue.SendCommand "PLACE FENCE ICON"
' Send a data points to the fence tool
CadInputQueue.SendDataPoint fenceStartPoint, 1
CadInputQueue.SendDataPoint fenceEndPoint, 1
' Set Delete Fence Contents selection to Inside and select the tool
CadInputQueue.SendCommand "FENCE DELETE"
CadInputQueue.SendCommand "LOCK FENCE INSIDE"
' Send data point to the Delete Fence Contents tool.
' This deletes anything from that particular area, since
' the only thing that should be in there is the cell we want
' Place active cell
CadInputQueue.SendCommand "PLACE CELL ICON"
' Clear selections and return to default controls
DrawingSetup.SetupControls
scanCriteria.Reset
' And now, we paste information back into the cell, from the array, if needed
Dim nodeTemplate As TextElement
Dim haveTemplate As Boolean
haveTemplate = False
Dim textEnum As ElementEnumerator
Set textEnum = cellCopy.AsTextNodeElement.GetSubElements
Do While (textEnum.MoveNext)
With textEnum.Current
If textEnum.Current.IsTextElement And Not haveTemplate Then
Set nodeTemplate = textEnum.Current
haveTemplate = True
' *** Here is where I set text style
Set oStyle = nodeTemplate.TextStyle
oStyle.InterCharacterSpacing = 0.2
Dim tempNode As TextNodeElement
Set tempNode = CreateTextNodeElement2(cellCopy.AsTextNodeElement, cellCopy.AsTextNodeElement.Origin, Matrix3dIdentity)
cellEle.Redraw msdDrawingModeErase
' Max number of lines in the area should be 4, so we will limit the checks to that
For XLine = 1 To 4
If nodeArray(nodeCounter, XLine) <> vbNullString Then
tempNode.AddTextLine nodeArray(nodeCounter, XLine)
Set textEnum = tempNode.GetSubElements
Dim textComp As Element
Dim nodeICS As Double
Set textComp = textEnum.Current
'******* And here is where I set the text using that style
Set textComp.AsTextElement.TextStyle = oStyle
textComp.Redraw
tempNode.Redraw
cellEle.AsCellElement.ReplaceCurrentElement tempNode
cellEle.Redraw
cellEle.Rewrite
' And now we just need to fix the stupid inter character spacing bug issue
CadInputQueue.SendCommand "MODIFY TEXT"
' Set a variable associated with a dialog box
SetCExpressionValue "tcb->msToolSettings.changeText.textstyle", 0, "MODIFY"
SetCExpressionValue "tcb->msToolSettings.changeText.font", 0, "MODIFY"
SetCExpressionValue "tcb->msToolSettings.changeText.height", 0, "MODIFY"
SetCExpressionValue "tcb->msToolSettings.changeText.width", 0, "MODIFY"
SetCExpressionValue "tcb->msToolSettings.changeText.linespace", 0, "MODIFY"
SetCExpressionValue "tcb->msToolSettings.changeText.linespacetype", 0, "MODIFY"
SetCExpressionValue "tcb->msToolSettings.changeText.slant", 0, "MODIFY"
SetCExpressionValue "tcb->msToolSettings.changeText.linelength", 0, "MODIFY"
SetCExpressionValue "tcb->msToolSettings.changeText.underline", 0, "MODIFY"
SetCExpressionValue "tcb->msToolSettings.changeText.vertical", 0, "MODIFY"
SetCExpressionValue "tcb->msToolSettings.changeText.viewind", 0, "MODIFY"
SetCExpressionValue "tcb->msToolSettings.changeText.just", 0, "MODIFY"
SetCExpressionValue "gUseChangeAnnotationScale", 0, "MODIFY"
' Send a reset to the current command
CadInputQueue.SendReset
CommandState.StartDefaultCommand