---

Hallo ihr da Draußen!

Ich habe folgendes Problem:
Ich erstelle mir meinen eigenen Schweißstempel, den ich mit Eingaben über eine UserForm füttern möchte.
Ich schaffe es, dass der Stempel gezeichnet wird. Ich schaffe es, auch, dass ein gewünschter Text auf der Stempelskizze erscheint.
Wenn ich dann anschließend dem Stempel speichere ("Skizze fertigstellen" drücke) und ihn per Mausklick auf meiner Zeichnung positioniere, dann ist der Text nicht mehr da.

Was mache ich da falsch?

Mit folgendem Code lasse ich den Stempel zeichnen:

Dim MyDoc As DrawingDocument
    Set MyDoc = ThisApplication.ActiveDocument
   
   
    Dim MySketchedSymbolDef As SketchedSymbolDefinition
    Set MySketchedSymbolDef = MyDoc.SketchedSymbolDefinitions.Add("Teststempel")
   
   
    Dim MySketch As DrawingSketch
    Call MySketchedSymbolDef.Edit(MySketch)
   
    Dim MyTG As TransientGeometry
    Set MyTG = ThisApplication.TransientGeometry
   
    Dim MySL As SketchLines
       
    'erster Kasten                                  Punkt unten links  und    oben rechts!
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 0), MyTG.CreatePoint2d(15, 0.55))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 0), MyTG.CreatePoint2d(11.8, 0.55))
    'zweiter kasten
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 0.55), MyTG.CreatePoint2d(15, 1.1))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 0.55), MyTG.CreatePoint2d(11.8, 1.1))
    'dritter Kasten
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 1.1), MyTG.CreatePoint2d(15, 1.65))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 1.1), MyTG.CreatePoint2d(11.8, 1.65))

Und hiermit dann das Textfeld:

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 GeneralNotes object
Dim oGeneralNotes As GeneralNotes
Set oGeneralNotes = oActiveSheet.DrawingNotes.GeneralNotes

Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry

' Generiert einen Text mit einem String als Input.

Dim sText As String
sText = "Wärmebehandlung"
Dim oGeneralNote As GeneralNote
Set oGeneralNote = oGeneralNotes.AddFitted(oTG.CreatePoint2d(0, 0.55), sText)

' Create a set of notes that are numbered and aligned along the left.
Dim dYCoord As Double
dYCoord = 14
Dim dYOffset As Double
Dim oStyle As TextStyle
Set oStyle = oGeneralNotes.Item(1).TextStyle
dYOffset = oStyle.FontSize * 12

Zum Teil ist der Code aus der Inventor API Hilfe..

Freundliche Grüße
M

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

---

Guten morgen,

vielleicht habe ich da ja auch irgendwas überlesen, aber ich finde keine Verbindung zwischen deiner Symbolerstellung und dem Text, den du da erstellst.
Wenn du den Text sowieso aus ner UserForm nimmst, dann erstell dir doch in deiner idw-Vorlage ein Symbol mit einer Eingabe. Dann platzierst du das Symbol per VBA und füllst die Eingabe aus.

------------------
MFG

Chris

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

---

Hallo,

Danke für deine Antwort.
Wie plaziere ich denn ein solches Symbol mit VBA auf der Zecihnung bzw. mit welchem Begriff kann/soll ich mal google füttern?

LG M

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

---

Das Symbol platzieren sollte folgendermaßen gehen:

Code:

---

Dim Doc As DrawingDocument
Set Doc = ThisApplication.ActiveDocument
    Dim osheet As Sheet
    Set osheet = Doc.ActiveSheet
    Dim oSketch As Sketch
    Dim oSymbol As SketchedSymbol
    Set oSymbol = osheet.SketchedSymbols.Item("DEIN SYMBOLNAME")
Dim oPlacementPoint As Point2d
Set oPlacementPoint = ThisApplication.TransientGeometry.CreatePoint2d("X-Koordinate", "Y-Koordinate")
Call osheet.SketchedSymbols.Add(oSymbol,oPlacementpoint)

---

------------------
MFG

Chris

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

---

Hallo,

Leider funktioniert der Quellcode bei mir nicht.

Ich habe ihn wie folgt angepasst:

Code:

---

Dim Doc As DrawingDocument
    Set Doc = ThisApplication.ActiveDocument
        Dim oSheet As Sheet
        Set oSheet = Doc.ActiveSheet
        Dim oSketch As Sketch
        Dim oSymbol As SketchedSymbol
        Set oSymbol = oSheet.SketchedSymbols.Item("Mein Name")
    Dim oPlacementPoint As Point2d
    Set oPlacementPoint = ThisApplication.TransientGeometry.CreatePoint2d(1, 1)
    Call oSheet.SketchedSymbols.Add(oSymbol, oPlacementPoint)

---

Hab ich da einen Bock geschossen?

LG M

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

---

So, nachdem ich mir nochmal ein paar Gedanken gemacht habe und deine Antwort nochmals durchgelesen habe:
Ich würde gerne ein Symbol per VBA erstellen, nicht "nur" plazieren.

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

---

Du möchtest jedes mal ein neues Symbol erstellen? Alternativ könntest du eine Skizze erstellen, in die du deine Tabelle zeichnest und den Text einfügst.

Code:

---

   
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    Dim osheet As Sheet
    Set osheet = oDoc.ActiveSheet
    Set oSketch = osheet.Sketches.Add
    Dim oTextbox As TextBox
    Dim sText As String
    sText = "DIES IST EIN TESTTEXT"

    Call oSketch.Edit

    Set oTextbox = oSketch.TextBoxes.AddFitted(ThisApplication.TransientGeometry.CreatePoint2d(1, 1), sText)

    oSketch.ExitEdit

---

------------------
MFG

Chris

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

---

Danek für deine Antwort, aber leider klappt der Code bei mir nicht.
Ich hab ihn soweit "eingepflegt", aber bei der Zeile:

Code:

---

Call oSketch.Edit

---

kommt der Fehler:
Laufzeitfehler '91':
Objektvariable oder With-Blockvariable nicht festgelegt

Woran liegt das?

LG M

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

---

Oh Sorry.

Bitte kommentiere die Zeile einmal aus.
Du befindest dich ja schon in der Skizze, da brauchst du sie ja nicht zum editieren aufrufen.

------------------
MFG

Chris

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

---

Gut, hab ich gemacht. Dann bringt er mir aber in der nächsten Zeile:

Code:

---

Set oTextbox = oSketch.TextBoxes.AddFitted(ThisApplication.TransientGeometry.CreatePoint2d(1, 1), sText)

---

Den selben Fehler wie eben.

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

---

Weiß denn Niemand rat? 

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

---

Poste doch mal den Code, den du jetzt hast, vielleicht kann man dann dort einen Fehler finden.

------------------
MFG

Chris

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

---

Oke, ihr habt es so gewollt:
Hiermit "zeichne" ich meinen Stempel:

Code:

---

    Dim MyDoc As DrawingDocument
    Set MyDoc = ThisApplication.ActiveDocument
   
   
    Dim MySketchedSymbolDef As SketchedSymbolDefinition
   
    Set MySketchedSymbolDef = MyDoc.SketchedSymbolDefinitions.Add(Stempel)
   
   
    Dim MySketch As DrawingSketch
    Call MySketchedSymbolDef.Edit(MySketch)
   
    Dim MyTG As TransientGeometry
    Set MyTG = ThisApplication.TransientGeometry
   
    Dim MySL As SketchLines
       
    'erster Kasten                                  Punkt unten links  und    oben rechts!
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 0), MyTG.CreatePoint2d(15, 0.55))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 0), MyTG.CreatePoint2d(11.8, 0.55))
    'zweiter kasten
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 0.55), MyTG.CreatePoint2d(15, 1.1))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 0.55), MyTG.CreatePoint2d(11.8, 1.1))
    'dritter Kasten
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 1.1), MyTG.CreatePoint2d(15, 1.65))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 1.1), MyTG.CreatePoint2d(11.8, 1.65))
    'vierter Kasten
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 1.65), MyTG.CreatePoint2d(15, 2.2))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 1.65), MyTG.CreatePoint2d(11.8, 2.2))
    'Fünfter Kasten
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 2.2), MyTG.CreatePoint2d(15, 3.3))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 2.2), MyTG.CreatePoint2d(11.8, 3.3))
    'Sechster Kasten
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 2.75), MyTG.CreatePoint2d(15, 3.3))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 2.75), MyTG.CreatePoint2d(11.8, 3.3))
    'siebter Kasten
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 3.3), MyTG.CreatePoint2d(15, 3.85))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 3.3), MyTG.CreatePoint2d(11.8, 3.85))
    'achter Kasten
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 3.85), MyTG.CreatePoint2d(15, 4.4))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 3.85), MyTG.CreatePoint2d(11.8, 4.4))
    'Überschrift
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.4), MyTG.CreatePoint2d(15, 4.95))
   
    'Textfelder zum händischen Ausfüllen:
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(15, 5.5))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(13.4, 5.5))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(11.8, 5.5))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(5.5, 5.5))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(1.5, 5.5))
    'Feld 2 ausfüllbar
    '
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(15, 6.05))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(13.4, 6.05))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(11.8, 6.05))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(5.5, 6.05))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(1.5, 6.05))
    'Feld 3 ausfüllbar
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(15, 6.6))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(13.4, 6.6))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(11.8, 6.6))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(5.5, 6.6))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(1.5, 6.6))
    'Feld 4 aufüllbar
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(15, 7.15))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(13.4, 7.15))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(11.8, 7.15))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(5.5, 7.15))
    Call MySketch.SketchLines.AddAsTwoPointRectangle(MyTG.CreatePoint2d(0, 4.95), MyTG.CreatePoint2d(1.5, 7.15))
 

---

Und die Felder wollte ich mit diesem Code dann füllen (der ist aus der API-Hilfe, wenn ich mich recht erinnere):

Code:

---

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 GeneralNotes object
    Dim oGeneralNotes As GeneralNotes
    Set oGeneralNotes = oActiveSheet.DrawingNotes.GeneralNotes
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry
    ' Create text with simple string as input. Since this doesn't use
    ' any text overrides, it will default to the active text style.
    Dim sText As String
    sText = "Drawing Notes"
    Dim oGeneralNote As GeneralNote
    Set oGeneralNote = oGeneralNotes.AddFitted(oTG.CreatePoint2d(3, 18), sText)
    ' Create text using various overrides.
    sText = "Notice: All holes larger than 0.500 n are to be lubricated."
    Set oGeneralNote = oGeneralNotes.AddFitted(oTG.CreatePoint2d(3, 16), sText)
    ' Create a set of notes that are numbered and aligned along the left.
    Dim dYCoord As Double
    dYCoord = 14
    Dim dYOffset As Double
    Dim oStyle As TextStyle
    Set oStyle = oGeneralNotes.Item(1).TextStyle
    dYOffset = oStyle.FontSize * 1.5
    ' Simple single line text.
    Set oGeneralNote = oGeneralNotes.AddFitted(oTG.CreatePoint2d(3, dYCoord), "1.")
    sText = "This is note 1."
    Set oGeneralNote = oGeneralNotes.AddFitted(oTG.CreatePoint2d(4, dYCoord), sText)
    ' Two line text. The two lines are defined using the tag within the text string.
    dYCoord = dYCoord - (oGeneralNote.FittedTextHeight + 0.5)
    Set oGeneralNote = oGeneralNotes.AddFitted(oTG.CreatePoint2d(3, dYCoord), "2.")
    sText = "This is note 2, which contains two lines."
    Set oGeneralNote = oGeneralNotes.AddFitted(oTG.CreatePoint2d(4, dYCoord), sText)
    ' Single line of text.
    dYCoord = dYCoord - (oGeneralNote.FittedTextHeight + 0.5)
    Set oGeneralNote = oGeneralNotes.AddFitted(oTG.CreatePoint2d(3, dYCoord), "3.")
    sText = "This is note 3."
    Set oGeneralNote = oGeneralNotes.AddFitted(oTG.CreatePoint2d(4, dYCoord), sText)
    ' Three lines of text.
    dYCoord = dYCoord - (oGeneralNote.FittedTextHeight + 0.5)
    Set oGeneralNote = oGeneralNotes.AddFitted(oTG.CreatePoint2d(3, dYCoord), "4.")
    sText = "This is note 4, which contains several lines."
    Set oGeneralNote = oGeneralNotes.AddFitted(oTG.CreatePoint2d(4, dYCoord), sText)
    dYCoord = dYCoord - (oGeneralNote.FittedTextHeight + 0.5)
    Set oGeneralNote = oGeneralNotes.AddFitted(oTG.CreatePoint2d(3, dYCoord), "5.")
    sText = "Here is the last and final line of text."
    Set oGeneralNote = oGeneralNotes.AddFitted(oTG.CreatePoint2d(4, dYCoord), sText)

---

Wenn ich in genau dieser Reihenfolge den Code ausführe erscheint auch dieser Text, aber der lässt sich dann auf Zeichnungsebene nicht verschieben bzw. wenn ich anschließend die Bearbeitungs des Symbols schließe und den Stempel dann setze, sind die Felder noch da, aber kein Text mehr....  

LG M

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

---

Ich habe den unteren Bereich mal umgeschrieben. So sollte es funktionieren:

Code:

---

Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    ' Set a reference to the active sheet.
    Dim oActiveSheet As Sheet
    Set oActiveSheet = oDrawDoc.ActiveSheet
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry
    ' Create text with simple string as input. Since this doesn't use
    ' any text overrides, it will default to the active text style.
   
    Dim oTextbox As TextBox
    Dim sText As String
    sText = "Drawing Notes"
 
    Set oTextbox = MySketch.TextBoxes.AddFitted(oTG.CreatePoint2d(3, 18), sText)
    ' Create text using various overrides.
    sText = "Notice: All holes larger than 0.500 n are to be lubricated."
    Set oTextbox = MySketch.TextBoxes.AddFitted(oTG.CreatePoint2d(3, 16), sText)
    ' Create a set of notes that are numbered and aligned along the left.
    Dim dYCoord As Double
    dYCoord = 14
    Dim dYOffset As Double
    Dim oStyle As TextStyle
    Set oStyle = oTextbox.Style
    dYOffset = oStyle.FontSize * 1.5
    ' Simple single line text.
    Set oTextbox = MySketch.TextBoxes.AddFitted(oTG.CreatePoint2d(3, dYCoord), "1.")
    sText = "This is note 1."
    Set oTextbox = MySketch.TextBoxes.AddFitted(oTG.CreatePoint2d(4, dYCoord), sText)
    ' Two line text. The two lines are defined using the tag within the text string.
    dYCoord = dYCoord - (oTextbox.FittedTextHeight + 0.5)
    Set oTextbox = MySketch.TextBoxes.AddFitted(oTG.CreatePoint2d(3, dYCoord), "2.")
    sText = "This is note 2, which contains two lines."
    Set oTextbox = MySketch.TextBoxes.AddFitted(oTG.CreatePoint2d(4, dYCoord), sText)
    ' Single line of text.
    dYCoord = dYCoord - (oTextbox.FittedTextHeight + 0.5)
    Set oTextbox = MySketch.TextBoxes.AddFitted(oTG.CreatePoint2d(3, dYCoord), "3.")
    sText = "This is note 3."
    Set oTextbox = MySketch.TextBoxes.AddFitted(oTG.CreatePoint2d(4, dYCoord), sText)
    ' Three lines of text.
    dYCoord = dYCoord - (oTextbox.FittedTextHeight + 0.5)
    Set oTextbox = MySketch.TextBoxes.AddFitted(oTG.CreatePoint2d(3, dYCoord), "4.")
    sText = "This is note 4, which contains several lines."
    Set oTextbox = MySketch.TextBoxes.AddFitted(oTG.CreatePoint2d(4, dYCoord), sText)
    dYCoord = dYCoord - (oTextbox.FittedTextHeight + 0.5)
    Set oTextbox = MySketch.TextBoxes.AddFitted(oTG.CreatePoint2d(3, dYCoord), "5.")
    sText = "Here is the last and final line of text."
    Set oTextbox = MySketch.TextBoxes.AddFitted(oTG.CreatePoint2d(4, dYCoord), sText)

---

------------------
MFG

Chris

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

---

Sehr geil, auf jeden Fall schonmal danke für deine Mühe, aber:
die Zeile:

Set oTextbox = MySketch.TextBoxes.AddFitted(oTG.CreatePoint2d(3, 18), sText)

spuckt mir einen Fehler aus. Es wird "MySketch" makiert und gesagt: "Fehler beim Kompilieren. Variable nicht definiert"
 

Grüße M

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

---

Hast du beide Code-Teile in einer Sub stehen?
Davon bin ich ausgegangen. Dann würde er die Definition von MySketch aus dem oberen Teil übernehmen.
Wenn du es in getrennten Subs machst, dann musst du die Variable natürlich übergeben.

------------------
MFG

Chris

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

---

In der gleichen Sub (*hust*) funktioniert es!!!!

Sau geil, vielen Dank!     

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