---

Hallo zusammen,

gibt es eine Möglichkeit an die Daten im Schriftfeld zu kommen?

Ich habe in meinem Schriftfeld eine Textbox "Rohmass", diese wird aus den iProperties des Bauteils gefüllt. Die Textbox hat eine gewisse Größe und wenn der Text zu lang ist, sieht das auf der Zeichnung nicht so schön aus. Also passe ich die Schriftgröße immer manuell an.
Das würde ich jetzt gern automatisieren. D.h.  ich würde gern die Länge des Textes abfragen und wenn der Text zu lang ist möchte ich gern die Schriftgröße ändern.

Ich bekomme es hin die Textbox in dem Schriftfeld zu finden, jedoch habe ich bis jetzt keine Möglichkeit gefunden auf den Text zuzugreifen.

Hat jemand eine Idee wie das funktioniert?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ich habe jetzt gerade kein fertiges Programm zur Hand, aber ich denke mit dem Stückchen Code kommst du zurecht:

Code:

---

Dim TextBoxValue As String
' TitleBlock ist dein Schriftfeld
' sourceTextBox ist die TextBox, die du ja bereis gefunden hast
TextBoxValue = TitleBlock.GetResultText(sourceTextBox)

---

------------------
Grüße
Andreas
etaCAD

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

Code:

---

Sub Suche_im_Schriftkopf()

Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument

  For Each oTextBox In oDrawDoc.ActiveSheet.TitleBlock.Definition.Sketch.TextBoxes
        If oTextBox.FormattedText = "Rohmass" Then
            oTextBox.Style.FontSize = 1
        End If
  Next
End Sub

---

Gruß Berno

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Moin

@bwr
Damit bekommst du nur den Textstring zurück. Informationen zu Länge sind darüber nicht zu erlangen.

@BernoAn
Der Inhalt der TextBox ist der Wert eines iProperties. In dem FormattedText steht also mindestens so etwas wie:

Code:

---

<Property Document='model' PropertySet='User Defined Properties' Property='Rohmass' FormatID='{D5CDD505-2E9C-101B-9397-08002B2CF9AE}' PropertyID='5'>Rohmass</Property>

---

Ich bin außerdem der Meinung, dass du damit die Schriftgröße im Textstil änderst. Das wirkt sich aber auf alle Texte die den gleichen Stil in dem Dokument verwenden aus und erzeugt, eine Verwendung einer zentralen Stilbibliothek vorausgesetzt, eine Warnmeldung zu abweichenden Stildefinitionen. Die Schriftgröße des Textes in der TextBox würde ich eher mit einem StyleOverride Tag vornehmen. Also in etwa:

Code:

---

<StyleOverride FontSize='0,5'><Property Document='model' PropertySet='User Defined Properties' Property='Rohmass' FormatID='{D5CDD505-2E9C-101B-9397-08002B2CF9AE}' PropertyID='5'>Rohmass</Property></StyleOverride>

---

@Andreas01
Auf den ersten Blick haben TextBoxen zwei Properties Width und FittedTextWidth, die man hier nutzen könnte. Die FittedTextWidth sollte nicht größer sein als Width. Also müsste man die Textgröße stufenweise reduzieren und immer wieder vergleichen. Leider funktioniert das nur mit Text und nicht mit Platzhaltern für z.B. Propertywerte. Statt dem Inhalt des iProps bestimmt der Platzhaltertext (in deinem Fall <Rohmass>) die FittedTextWidth.
Demzufolge müsste man also den Platzhalter im FormattedText durch den entsprechenden Propertywert (s. Post von Andreas) ersetzen, die Größenanpassung vornehmen und danach wieder den Platzhalter einsetzen.
Der FormattedText ist eine XML-Struktur. Bindet man per Verweis "Microsoft XML v3" ein, kann man sich ein XML-Document Objekt erzeugen und in der Struktur herumwurschteln. Das ist wesentlich einfacher, als in dem String Teile herauszuschneiden.

Mal Quick'n Dirty zusammengenagelt   
(Verweis auf MSXMLv3 setzen nicht vergessen!)

Code:

---

Option Explicit

Private Sub TextWidth()

Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument

Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet

Dim oTB As TitleBlock
Set oTB = oSheet.TitleBlock

Dim oSketch As DrawingSketch

Call oTB.Definition.Edit(oSketch)

Dim oTBox As TextBox
Set oTBox = oSketch.TextBoxes(1) ' <----- Hier anpassen für deine TextBox

Dim sResultText As String
sResultText = oTB.GetResultText(oTBox)

Dim objXML As msxml2.DOMDocument
Set objXML = New msxml2.DOMDocument

' Ersetzen der iProp Verlinkung durch Text
Dim sXML As String
sXML = oTBox.FormattedText

Dim oAttr As IXMLDOMAttribute
Dim oSONode As IXMLDOMNode
Dim oPNode As IXMLDOMNode
Dim oNode As IXMLDOMNode
Dim oChildNode As IXMLDOMNode

' Create a SyleOverride node
Set oSONode = objXML.createNode(msxml2.NODE_ELEMENT, "StyleOverride", "") 'StyleOverride
Set oAttr = objXML.createAttribute("FontSize")
oAttr.Value = Replace(CStr(Round(oTBox.Style.FontSize, 2)), ".", ",")
'Add the attribute to the node.
Call oSONode.Attributes.setNamedItem(oAttr)

' Falls kein XML-Objekt generiert werden konnte, bauen wir eines (kommt bei einem Property als Inhalt nie vor, aber bei reinem Text)
If Not objXML.loadXML(sXML) Then  'sXML is the string with XML'
    'insert StyleOverride Node
    Call objXML.appendChild(oSONode)
   
    'insert regular text (property value)
    oSONode.Text = sResultText
Else
' Gibt es schon einen PropertyNode aber ohne StyleOverride?
    For Each oNode In objXML.ChildNodes
        If oNode.baseName = "Property" And oNode.Text = "Rohmass" Then
            Set oPNode = oNode

            'insert StyleOverride Node
            Call objXML.replaceChild(oSONode, oNode)
       
            'insert regular text (property value)
            oSONode.Text = sResultText
       
            Exit For
        ElseIf oNode.baseName = "StyleOverride" Then
            For Each oChildNode In oNode.ChildNodes
                If oChildNode.baseName = "Property" And oNode.Text = "Rohmass" Then
                    Set oPNode = oNode
                   
                    'insert StyleOverride Node
                    Call objXML.replaceChild(oSONode, oNode)
   
                    'insert regular text (property value)
                    oSONode.Text = sResultText
       
                    Exit For
                End If
            Next
        End If
    Next
End If

'write back XML string to textbox
oTBox.FormattedText = objXML.XML

' jetzt sollte ein XML Tag mit dem StyleOverride und dem Inhalt des Rohmass iProps vorhanden sein
' Prüfen und skalieren der Textgröße
Do While oTBox.Width < oTBox.FittedTextWidth
    For Each oAttr In oSONode.Attributes
        If oAttr.baseName = "FontSize" Then
            If CDbl(oAttr.nodeValue) - 0.01 <= 0.2 Then
                Call MsgBox("Minimale Schriftgröße erreicht. Abbruch", vbCritical, "Scale text size")
                Exit Do 'Notausstieg, bevor der Text unleserlich klein wird
            End If
            oAttr.nodeValue = Replace(oAttr.nodeValue - 0.01, ".", ",")
            oTBox.FormattedText = objXML.XML
        End If
    Next
Loop

' Wiederherstellung der iProp Verlinkung
If Not oPNode Is Nothing Then
    oSONode.Text = ""
    Call oSONode.appendChild(oPNode)
End If

'write back XML string to textbox
oTBox.FormattedText = Replace(objXML.XML, Chr(13) & Chr(10), "")

Call oTB.Definition.ExitEdit(True)
   
End Sub

---

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

danke für die Antworten. Also ganz so einfach scheint das wohl nicht zu sein. Habe aktuell wennig Zeit um das Programm fertig zu schreiben.

Gruß
Andreas

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP