---

Guten Tag zusammen,:

Ich bin neu in diesem Forum und habe eine Frage zu Thema Positionsnummern anpassen mit VBA. 

Aber erst einmal zu mir : Ich bin Maschinenbauingenieur und arbeite seit 25 Jahren in der Automobilbranche
vorwiegend mit Catia V5 und NX. Mit VBA kenne ich mich nur wenig aus was Inventor betrifft.

Seit einiger Zeit haben wir ein Tochterunternehmen gekauft und ich soll jetzt
deren CAD System an unseres anpassen. Was natürlich nur begrenzt geht. Genau genommen sollen die DWG die aus Inventor kommen
von der Optik denen von Catia u. NX gleichen. Zum  Teil konnte ich das über die Stilbibliothek anpassen, aber nur zum Teil.
Die Geschäftführung möchte gerne die Positionsnummer in etwa so habe; Positionsnummer dann als zweite Zeile die Bezeichnung und so weiter.
Jetzt werden einige von euch sagen das geht mit Bortmitteln ok, aber die zweite und dritte Zeilen sollen einen andern Schriftstil und Schriftgröße haben.
Ich habe dazu eine Vba code snippet in der API-Hilfe gefunden. Komme aber nicht an den Schriftstil ran.
Könnte mir jemand von euch einen Tipp geben wie ich an den Schriftstil und Größe kommen um diese anzupassen?

Hier mein erster: Ansatz: wohl bemerkt er ist aus der API Hilfe

Public Sub CreateBalloon()
    ' Set a reference to the drawing document.
    ' This assumes a drawing document is active.
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument

    ' Set a reference to the active sheet.
    Dim oActiveSheet As Sheet
    Set oActiveSheet = oDrawDoc.ActiveSheet

    ' Set a reference to the drawing curve segment.
    ' This assumes that a drwaing curve is selected.
    Dim oDrawingCurveSegment As DrawingCurveSegment
    Set oDrawingCurveSegment = oDrawDoc.SelectSet.Item(1)

    ' Set a reference to the drawing curve.
    Dim oDrawingCurve As DrawingCurve
    Set oDrawingCurve = oDrawingCurveSegment.Parent

    ' Get the mid point of the selected curve
    ' assuming that the selection curve is linear
    Dim oMidPoint As Point2d
    Set oMidPoint = oDrawingCurve.MidPoint

    ' Set a reference to the TransientGeometry object.
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry

    Dim oLeaderPoints As ObjectCollection
    Set oLeaderPoints = ThisApplication.TransientObjects.CreateObjectCollection

    ' Create a couple of leader points.
    Call oLeaderPoints.Add(oTG.CreatePoint2d(oMidPoint.X + 10, oMidPoint.Y + 10))
    Call oLeaderPoints.Add(oTG.CreatePoint2d(oMidPoint.X + 10, oMidPoint.Y + 5))

    ' Add the GeometryIntent to the leader points collection.
    ' This is the geometry that the balloon will attach to.
    Dim oGeometryIntent As GeometryIntent
    Set oGeometryIntent = oActiveSheet.CreateGeometryIntent(oDrawingCurve)
    Call oLeaderPoints.Add(oGeometryIntent)

    ' Set a reference to the parent drawing view of the selected curve
    Dim oDrawingView As DrawingView
    Set oDrawingView = oDrawingCurve.Parent

    ' Set a reference to the referenced model document
    Dim oModelDoc As Document
    Set oModelDoc = oDrawingView.ReferencedDocumentDescriptor.ReferencedDocument

    ' Check if a partslist or a balloon has already been created for this model
    Dim IsDrawingBOMDefined As Boolean
    IsDrawingBOMDefined = oDrawDoc.DrawingBOMs.IsDrawingBOMDefined(oModelDoc.FullFileName)

    Dim oBalloon As Balloon

    If IsDrawingBOMDefined Then

        ' Just create the balloon with the leader points
        ' All other arguments can be ignored
        Set oBalloon = oDrawDoc.ActiveSheet.Balloons.Add(oLeaderPoints)
    Else

        ' First check if the 'structured' BOM view has been enabled in the model

        ' Set a reference to the model's BOM object
        Dim oBOM As BOM
        Set oBOM = oModelDoc.ComponentDefinition.BOM

        If oBOM.StructuredViewEnabled Then

            ' Level needs to be specified
            ' Numbering options have already been defined
            ' Get the Level ('All levels' or 'First level only')
            ' from the model BOM view - must use the same here
            Dim Level As PartsListLevelEnum
            If oBOM.StructuredViewFirstLevelOnly Then
                Level = kStructured
            Else
                Level = kStructuredAllLevels
            End If

            ' Create the balloon by specifying just the level
            Set oBalloon = oActiveSheet.Balloons.Add(oLeaderPoints, , Level)
        Else

            ' Level and numbering options must be specified
            ' The corresponding model BOM view will automatically be enabled
            Dim oNumberingScheme As NameValueMap
            Set oNumberingScheme = ThisApplication.TransientObjects.CreateNameValueMap

            ' Add the option for a comma delimiter
            oNumberingScheme.Add "Delimiter", ","

            ' Create the balloon by specifying the level and numbering scheme
            Set oBalloon = oActiveSheet.Balloons.Add(oLeaderPoints, , kStructuredAllLevels, oNumberingScheme)
        End If
    End If
End Sub

Bin für jede Hilfe dankbar

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

---

Guten Morgen,

check mal das TextStyle Object.

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

---

Hallo CAD Kalle,

mehrzeilige Positionsnummer ist kein Problem, aber es gibt meines Wissens keine Möglichkeit die Positionsnummer weder über API noch mit Inventor-Bordmitteln so anzupassen, dass

Zitat:

---

die zweite und dritte Zeilen sollen einen andern Schriftstil und Schriftgröße haben.

---

Eine Möglichkeit wäre Positionsnummer durch Führungslinientext zu ersetzen. Nur wird hierbei als Nachteil die tatsächliche Positionsnummer nicht automatisch aktualisiert. Man könnte aber diese Methode z.B. automatisch vor DWG-Export ausführen zu lassen und nach Export wieder rückgängig machen.

------------------
alex

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

---

Hallo 

Also mehrzeilig ist das ganze wirklich kein Problem. 2 Unterschiedliche Schriftstile sind aber nicht möglich. Das ganze jetzt durch Tricks zu umgehen ist immer ein heißes Eisen, sagen wir mal so. Da schleichen sich sehr schnell Fehler ein.

Würde also empfehlen mit der Beschränkung auf einen Schriftstil zu leben.

Damit ich nicht nur klug daherrede sondern auch was sinnvolles zu deinem Problem beitragen kann, hier ein Beispiel wie ein Textstil gesucht wird und für eine Positionsnummer vergeben wird.
Denke die richtigen Stellen zum Ändern findest du schon und ansonsten ist das auch recht selbsterklärend.

Was du auf jedenfall übernehmen solltest wäre die ersten paar Zeilen in denen sichergestellt wird dass man sich in der Richtigen Datei befindet.

Zum Testen eine Zeichnung öffnen, das Suchkriterium dementsprechend anpassen, eine Positionsnummer markieren und den Code starten.

Code:

---

Sub test()

Dim Test1 As Balloon
Dim oselect As SelectSet
Dim odoc As Inventor.DrawingDocument
Dim oapp As Application

Set oapp = ThisApplication
If oapp.Documents.VisibleDocuments.Count = 0 Then Exit Sub
If oapp.ActiveDocument.DocumentType <> kDrawingDocumentObject Then Exit Sub
Set odoc = ThisApplication.ActiveDocument

'Als Test eingefügt, die Positionsnummer muss natürlich anders gefunden werden
Set oselect = ThisApplication.ActiveDocument.SelectSet
Set Test1 = oselect.Item(1)

Dim oStyleManager As Inventor.DrawingStylesManager
Dim oStyle As Inventor.TextStyle

Set oStyleManager = odoc.StylesManager

For Each oStyle In oStyleManager.TextStyles
    'Mehrere Kriterien für Suche möglich
    If oStyle.InternalName = "Gesuchter Stil" Then
        Exit For
    End If
Next

'Stil an die Positionsnummer übergeben
If Not oStyle Is Nothing Then
    Test1.Style.TextStyle = oStyle
End If

End Sub

---

Hoffe das hilft dir weiter

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

---

Hallo Tacker,

werde Deinen Rat mit dem Schriftstil übernehmen und mit einem Schriftstil weiter machen und sehen was sich ergibt.
Aber trotzdem Danke für Deinen Hinweis.

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