Code:
Public Function GetTextFeatures(Fieldname As String, LabelID As Long) As Long ' Labelfeatureklasse
Dim LabelFeatureClass As Autodesk.Map.IM.Data.FeatureClass
' Mögliche Elemente für Elementfilter
_AcadTypen = "TEXT,MTEXT"
' Auswahlfilter bilden
Dim values() As TypedValue = {New TypedValue(DxfCode.Start, _AcadTypen)}
Dim Filter As New SelectionFilter(values)
' Optionen für Auswahl
Dim SelOptionen As New PromptSelectionOptions
SelOptionen.MessageForAdding = "Objekte (" & _AcadTypen & ") zur Übernahme wählen"
SelOptionen.AllowDuplicates = False
' Auswahl
Dim SelResult As PromptSelectionResult
SelResult = _Editor.GetSelection(SelOptionen, Filter)
If Not SelResult.Status = PromptStatus.OK Then
Return 0
End If
' In selectionset übernehmen
_SelectionSet = SelResult.Value
Dim IdArray As ObjectId()
IdArray = _SelectionSet.GetObjectIds()
' Transactionmanger
Dim TransactionM As Autodesk.AutoCAD.DatabaseServices.TransactionManager
TransactionM = _Database.TransactionManager
' Transaction
Dim mTransaction As Transaction
mTransaction = TransactionM.StartTransaction()
Dim acEntity As Entity
Dim acMText As MText
Dim acText As DBText
Dim Layername As String
Dim EntityName As String = ""
Dim Farbindex As Integer
Dim LinienTyp As String
Dim Rechts As Double
Dim Hoch As Double
Dim Z As Double
Dim Orientation As Double = 0
Dim Feature As Autodesk.Map.IM.Data.Feature
Dim LabelFeature As Autodesk.Map.IM.Data.Feature
Dim Height As Double = 1
Dim Textvalue As Double
' FID Liste zurücksetzen
Dim FIDs As String = ""
Try
_Editor.WriteMessage((ControlChars.Lf & "Gewählte Objekte " & _SelectionSet.Count))
Dim Oid As ObjectId
For Each Oid In IdArray
Height = 1
Textvalue = ""
acEntity = TransactionM.GetObject(Oid, OpenMode.ForRead, True)
Orientation = 0
Layername = acEntity.Layer
Farbindex = acEntity.ColorIndex
LinienTyp = acEntity.Linetype
Feature = _TB_FeatureClass.CreateFeature()
If TypeOf (acEntity) Is Autodesk.AutoCAD.DatabaseServices.DBText Then
acText = acEntity
EntityName = "TEXT"
Rechts = acText.Position.X
Hoch = acText.Position.Y
Z = acText.Position.Z
Textvalue = acText.TextString
Orientation = acText.Rotation
Height = acText.Height
End If
Dim xx As Autodesk.AutoCAD.DatabaseServices.MTextFragment
If TypeOf (acEntity) Is Autodesk.AutoCAD.DatabaseServices.MText Then
acMText = acEntity
EntityName = "MTEXT"
' Position ???
' ????????????????????????????
' Text ohne Formatierung ???
Textvalue = acMText.Text
Orientation = acMText.Rotation
Height = acMText.Height
End If
Feature = _TB_FeatureClass.CreateFeature()
If Feature.Attributes.Contains(Fieldname) Then
Feature.Attributes.Item("Fieldname").Value = Orientation
End If
Dim ParentFID As Long = Feature.FID
Dim LabelDefID As Long = LabelID
Dim TextField As String = Fieldname
' Je nach Zielobjektklasse
If Feature.FeatureClass.Type = Autodesk.Map.IM.Data.FeatureClassType.Attribute Then
' Labelfeatureklasse
LabelFeatureClass = _TB_FeatureClass.LabelFeatureClass
' Neues Labelfeature anlegen
LabelFeature = LabelFeatureClass.CreateFeature()
' Feld zuweisen
TextField = Fieldname
ElseIf Feature.FeatureClass.Type = Autodesk.Map.IM.Data.FeatureClassType.Point Then
' Labelfeatureklasse
LabelFeatureClass = _TB_FeatureClass.LabelFeatureClass
' Neues Labelfeature anlegen
LabelFeature = LabelFeatureClass.CreateFeature()
' Textposition auch als Punkt
Feature.Geometry = New Autodesk.Map.IM.Graphic.Point(Rechts, Hoch)
' Feld zuweisen
TextField = Fieldname
ElseIf Feature.FeatureClass.Type = Autodesk.Map.IM.Data.FeatureClassType.Label Then
LabelFeatureClass = _TB_FeatureClass
' LabelFeature ist bereits Feature
LabelFeature = Feature
' Feld zuweisen
TextField = "Label_Text"
' Kein Parentobjekt
ParentFID = 0
End If
' Geometrie zuweisen
LabelFeature.Geometry = New Autodesk.Map.IM.Graphic.Point(Rechts, Hoch)
LabelFeature.Attributes.Item(TextField).Value = Textvalue
' Labeldefinition und Relation (wenn nicht schon Labelfeatureklasse
If ParentFID > 0 Then
LabelFeature.Attributes.Item(Autodesk.Map.IM.Data.Feature.FIDParentColumn).Value = ParentFID
LabelFeature.Attributes.Item(Autodesk.Map.IM.Data.Feature.LabelDefIdColumn).Value = LabelDefID
End If
' Richtung
If LabelFeature.Attributes.Contains("ORIENTATION") Then
Feature.Attributes.Item("ORIENTATION").Value = Orientation
End If
Foren auf CAD.de (alle Foren)
| 
