I have a feature in code (a water main). It has a SUBTEXT defined in the MA called W_MainText. (Interactive placement via the +A icon works fine.)
So I write the text after getting the right point for placement. The first 3 lines below work fine. But you can see from the lines below that that I'm groping. A quick 30 minutes with the vba.chm and the xft.chm have made this process a bit clearer, but I can't seem to close on setting the placement mode to ALIGN.
CreateAnnotation "W_MainText", oFtr, pntForAnno oFtr.ApplyAttributeChanges oFtr.Write False ' need to get at the subfeature somehow... Dim subFeature As feature Dim j As Long Dim subCount As Long subCount = oFtr.SubFeatureCount For j = 0 To subCount - 1 Set subFeature = oFtr.GetSubFeature(j) Set the text placement mode to ALIGN Next j
I suppose I should have set the placement mode before CreateAnnotation "W_MainText", oFtr, pntForAnno, right?
So a bit more chm reading and it looks like I could
Dim oTextParams As New xft.TextParams
oTextParams.TextMode = annotationTextMode_<I wish for "Align" here>
CreateAnnotation "W_MainText", oFtr, pntForAnno
Except there is no annotationTextMode_Align
I thought surely this would work, but all the text comes out at zero, even though I can see that oAngle is set to other values.
Dim oAngle As New xft.InputValue
oAngle.SetTypeAndValue ValueType_VALUE, dblAngle <I know dblAngle is correct.>
Dim oRotation As New xft.Rotation
oRotation.SetByAngle oAngle
oTextParams.SetAlignment oRotation
oFtr.ApplyAttributeChanges
oFtr.Write False
Charlie,
I would recommend that you review the PlaceAnnotation2 method in the Library module of the xfmStdOpsLib.mvba (e.g. the XFM Standard Operations Library) delivered with Bentley Map in the ...\Bentley\Map\vba folder. The code in that method will demonstrate the various text placement modes such as "Away", "Align", "On" and others. If you've further questions after reviewing that code, please let us know.
Regards,
Jeff Bielefeld [Bentley]
Success! Although I did not have much luck with PlaceAnnotation2 (It seemed aimed at interactive placement, and I could never quite get the subfeature to rotate), I adapted a function provided by Bentley services. The main deal was to set the rotation on the initial text node placement rather than let it place at Matrix3dIdentity and then try to edit the subfeature.
Public Function CreateAnnotationWithRotation2(annoname As String, ByRef oFtr As xft.feature, _
pntCreate As Point3d, rotation As Matrix3d)
'to add anno
Dim oNewElem As Element
Dim oNewFtr As xft.feature
'create a text node elem
Set oNewElem = Application.CreateTextNodeElement1(Nothing, pntCreate, rotation)
Set oNewFtr = New xft.feature
'add this as a feature to the parent
'these set the various values required for creating a feature
oNewFtr.Geometry = oNewElem
'alias must equal the Placement name; i.e. "OH Primary" to get children
oNewFtr.Alias = annoname '"W_FireHydrant_Text1"
'name must equal the stored name; i.e. "edist_oh_primary"
oNewFtr.Name = annoname
'ftrTable
oNewFtr.Group = "xPlacement"
'FtrName = "Pole"
'end value set
'add the child records to the parent
oNewFtr.SetParentFeature oFtr
oNewFtr.AddSelfToParent
xft.PropMgr.InitializeOperationProperties oNewFtr.Name, "W_MainText"
oNewFtr.InitializeProperties "W_MainText"
End Function
Before calling this function, you have to determine the rotation, which is done by finding the angle from end points of the closest segment. This sub also offsets the text a bit away fromt he line, and corrects that offset for lines that slant between 290 and 340 degrees.
Private Sub PlaceAnno(pntOnMain As Point3d, oFtr As feature, oElem As Element)
Dim pntForAnno As Point3d Dim rotationMatrix As Matrix3d Dim oTempLineElement As LineElement ' point for anno will be left in X and up in Y... pntForAnno.X = pntOnMain.X - 60 pntForAnno.Y = pntOnMain.Y + 60 pntForAnno.Z = pntOnMain.Z
' find the segment for deriving the text rotation... Dim index As Long Dim pntForRotation1 As Point3d Dim pntForRotation2 As Point3d Dim dblAngle As Double Dim dblAngleInDegrees As Double Set oTempLineElement = oElem.AsLineElement index = oElem.AsVertexList.GetClosestSegment(pntOnMain)
pntForRotation1 = oTempLineElement.Vertex(index + 1) pntForRotation2 = oTempLineElement.Vertex(index + 2)
dblAngle = GetAngleFromEndPts(pntForRotation1, pntForRotation2) dblAngle = dblAngle - Pi / 2
If dblAngle > Pi / 2 And dblAngle < 3 * Pi / 2 Then dblAngle = dblAngle + Pi End If ' correct for a pipe that runs northwest to southeast, i.e., slope = -1 ' which means the dblAngle is in the 315 range (360 minus 45)... dblAngleInDegrees = Application.Degrees(dblAngle) If dblAngleInDegrees < 0 Then dblAngleInDegrees = dblAngleInDegrees + 360 End If If dblAngleInDegrees > 290 And dblAngleInDegrees < 340 Then pntForAnno.X = pntOnMain.X + 60 End If rotationMatrix = Matrix3dIdentity rotationMatrix = Matrix3dFromAxisAndRotationAngle(2, dblAngle)
CreateAnnotationWithRotation2 "W_MainText", oFtr, pntForAnno, rotationMatrix oFtr.ApplyAttributeChanges oFtr.Write False
End Sub
This sub is called by an earlier sub that arranges multiple placements of text if the pipe is long:
Private Sub CreateAnnoForLineElementTypes_Multiplacement(ByRef oFtr As feature, oElem As Element)
' Like the others, but this version wants to place the anno evey 1,000 feet or so... Dim lengthTotal As Double Dim lengthRemaining As Double Dim lengthCumulative As Double Dim pntOnMain As Point3d
lengthTotal = oFtr.GetProperty("ACTUAL_LENGTH") lengthRemaining = lengthTotal lengthCumulative = 0
' omit annotation for short pipes (less than 300 feet actual length)... If lengthTotal > 300 And lengthTotal <= 1000 Then
' set the point for placing the text... pntOnMain = oElem.AsTraversableElement.PointAtDistance(lengthTotal / 2) PlaceAnno pntOnMain, oFtr, oElem
Else ' length >= 1000 ' so place anno at 700 and see if there is another 1000... Do While lengthRemaining > 1000
pntOnMain = oElem.AsTraversableElement.PointAtDistance(lengthCumulative + 700) PlaceAnno pntOnMain, oFtr, oElem lengthRemaining = lengthRemaining - 1000 lengthCumulative = lengthCumulative + 1000 Loop
End If
And it all starts with a button click that sets up a scanner enumerator that picks just mains and then selects the processing style based on element type.
Private Sub cmd_Create_Main_Annotation_Click()
Dim ee As ElementEnumerator Dim oElem As Element Dim oScanCriteria As ElementScanCriteria Dim oLevel As Level Dim oLevels As Levels Dim oFtr As xft.feature Dim i As Integer Dim elemType As String Dim elemCounter As Double elemCounter = 0 Dim iCounter As Long iCounter = 0 ' tell the user you're working... lblStatus.Caption = "Working..." DoEvents ' restrict scan criteria to Mains... Set oLevels = ActiveDesignFile.Levels Set oScanCriteria = New ElementScanCriteria oScanCriteria.ExcludeAllLevels
For i = 1 To oLevels.count Set oLevel = oLevels.Item(i) If UCase(oLevel.Name) = "W_MAIN" Then oScanCriteria.IncludeLevel oLevel End If Next i
' scan for mains... Set ee = ActiveModelReference.Scan(oScanCriteria)
Do While ee.MoveNext elemCounter = elemCounter + 1 Set oElem = ee.Current Set oFtr = CreateFeature(oElem) ' oFtr will be the W_MAIN... elemType = oElem.Type Select Case elemType Case "3" ' line... ' CreateAnnoForLineElementTypes oFtr, oElem CreateAnnoForLineElementTypes_Multiplacement oFtr, oElem Case "4" ' linestring... ' CreateAnnoForLineElementTypes oFtr, oElem CreateAnnoForLineElementTypes_Multiplacement oFtr, oElem Case "12" ' complex string... CreateAnnoForComplexStringElementTypes oFtr, oElem Case "16" ' arc...Let's ignore these for now...
Case Else ' one complex shape in data set. Ignore... End Select
' If elemCounter > 200 Then' Exit Do' End If
Loop Debug.Print elemCounter Debug.Print iCounter ' tell the user you're done... lblStatus.Caption = "Writing annotation for mains is complete."
This code processes about 20,000 mains in about 40 seconds.