---

Hallo miteinander
für ein Automatisierungsprojekt versuche ich das Oberfächensymbol mit VBA oder iLogic auf einen definierten Punkt auf dem Zeichnungsblatt zu platzieren.
In der API von Inventor gibt es ein Bespiel wo das Symbol an ein Mass angeheftet wird. das funktioniert auch gut. Nur brauche ich das Symbol ohne Führungslinie oder zusätzlichen Mausklick.
Ich habe schon einiges versucht, auch mit KI (da ich kein Programmierer bin) aber leider erfolglos.
kann mir jemand weiterhelfen, dass das Ding funktioniert?

Sub PlaceSurfaceTextureSymbol()
    ' Deklaration der Variablen
    Dim oApp As Application
    Dim oDoc As DrawingDocument
    Dim oSheet As Sheet
   
    Dim oPoint As Point2d
    Dim oSurfaceSymbol As SurfaceTextureSymbol

    ' Verweis auf die Inventor-Anwendung und das aktive Dokument
    Set oApp = ThisApplication
    Set oDoc = oApp.ActiveDocument

    ' Überprüfen, ob das aktive Dokument eine Zeichnung ist
    If oDoc.DocumentType <> kDrawingDocumentObject Then
        MsgBox "Bitte öffnen Sie eine Zeichnung."
        Exit Sub
    End If

    ' Verweis auf das aktive Blatt
    Set oSheet = oDoc.ActiveSheet

    ' Erstellen eines Punktes für die Platzierung des Symbols
    Set oPoint = oApp.TransientGeometry.CreatePoint2d(10, 10)

    ' Hinzufügen des Oberflächensymbols
    Set oSurfaceSymbol = oSheet.SurfaceTextureSymbols.Add(oPoint)

    ' Festlegen der Attribute des Oberflächensymbols
    oSurfaceSymbol.SurfaceTextureType = kRoughnessType
    oSurfaceSymbol.ProductionMethod = "Fräsen"
    oSurfaceSymbol.MaximumRoughness = 3.2

    MsgBox "Oberflächensymbol erfolgreich platziert!"
End Sub

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

---

Moin

Das Beispiel aus der Hilfe ist Grütze. Die Add-Methode für SurfaceTextureSymbols gibt es nicht (mehr). Funktioniert zwar, aber nirgends dokumentiert. Dein Fehler war, das du einen Point2D übergeben hast, aber eine ObjectCollection aus Punkten gefordert ist.
Schau mal, ob es so hinkommt:

Code:

---

Option Explicit

Sub PlaceSurfaceTextureSymbol()
    ' Deklaration der Variablen
    Dim oApp As Inventor.Application
    Dim oDoc As DrawingDocument
    Dim oSheet As Sheet
  
    Dim oPoint As Point2d
    Dim oSurfaceSymbol As SurfaceTextureSymbol

    ' Verweis auf die Inventor-Anwendung und das aktive Dokument
    Set oApp = ThisApplication
   
    ' Überprüfen, ob das aktive Dokument eine Zeichnung ist
    If Not oApp.ActiveDocumentType = kDrawingDocumentObject Then
        MsgBox "Bitte öffnen Sie eine Zeichnung."
        Exit Sub
    End If

    Set oDoc = oApp.ActiveDocument
   
    ' Verweis auf das aktive Blatt
    Set oSheet = oDoc.ActiveSheet

    ' Erstellen einer ObjectCollection
    Dim oPointColl As ObjectCollection
    Set oPointColl = oApp.TransientObjects.CreateObjectCollection
   
    ' Erstellen eines Punktes für die Platzierung des Symbols
    Set oPoint = oApp.TransientGeometry.CreatePoint2d(10, 10)
   
    'Hinzufügen des Punktes zur ObjectCollection
    Call oPointColl.Add(oPoint)
   
    'Erzeugen einer SurfaceTextureSymbolDefinition
    Dim oSurfaceTextureSymbolDef As SurfaceTextureSymbolDefinition
    Set oSurfaceTextureSymbolDef = oSheet.SurfaceTextureSymbols.CreateDefinition()
   
    ' Hinzufügen des Oberflächensymbols
    Set oSurfaceSymbol = oSheet.SurfaceTextureSymbols.AddByDefinition(oPointColl, oSurfaceTextureSymbolDef)

    ' Festlegen der Attribute des Oberflächensymbols
    oSurfaceSymbol.SurfaceTextureType = kMaterialRemovalRequiredSurfaceType '= kRoughnessType
    oSurfaceSymbol.ProductionMethod = "Fräsen"
    oSurfaceSymbol.MaximumRoughness = "3.2"

    MsgBox "Oberflächensymbol erfolgreich platziert!"
End Sub

---

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

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

---

Hallo rkauskh
Super..... herzlichen Dank ..
..und schon wieder mal was von dir gelernt!

Das VBA funktioniert einwandfrei.

Freundliche Grüsse und eine gute Woche!
Jürg

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