---

Hallo zusammen,
ich suche heute eine Möglichkeit ein skizziertes Symbol von einer idw in eine andere zu kopieren.
Mein bisheriger Code:

Code:

---

Private Sub getSymbol()
Dim oDoc1 As Inventor.DrawingDocument:        Set oDoc1 = ThisApplication.ActiveDocument
Dim oDoc2 As Inventor.DrawingDocument:        Set oDoc2 = ThisApplication.Documents.Open("C:\VorlageSymbole.idw")
Dim oSheet1 As Inventor.Sheet:                Set oSheet1 = oDoc1.Sheets(1)
Dim oSheet2 As Inventor.Sheet:                Set oSheet2 = oDoc2.Sheets(1)

Dim oSSD As Inventor.SketchedSymbolDefinition: Set oSSD = Nothing
Dim oSS As Inventor.SketchedSymbol
For Each oSS In oSheet2.SketchedSymbols
If oSS.Name = "Symbol004" Then
  Set oSSD = oSS.Definition
  Exit For
End If
Next

If Not oSSD Is Nothing Then
Dim oPunkt As Inventor.Point2d:        Set oPunkt = ThisApplication.TransientGeometry.CreatePoint2d(0, 0)
Call oSheet1.SketchedSymbols.add(oSSD, oPunkt)
End If
End Sub

---

Leider stürzt der Code beim einfügen in oSheet1 mit Run-time error '5': Invalid procedure call or argument ab.
Was mache ich falsch?

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

---

Hallo

Ich habe dir deinen Code umgeschrieben das er funktioniert!

Code:

---

Private Sub getSymbol()
Dim oDoc1 As Inventor.DrawingDocument:        Set oDoc1 = ThisApplication.ActiveDocument
Dim oDoc2 As Inventor.DrawingDocument:        Set oDoc2 = ThisApplication.Documents.Open("C:\VorlageSymbole.idw")
Dim oSheet1 As Inventor.Sheet:                Set oSheet1 = oDoc1.Sheets(1)
Dim oSheet2 As Inventor.Sheet:                Set oSheet2 = oDoc2.Sheets(1)

Dim oSSD As Inventor.SketchedSymbolDefinition: Set oSSD = Nothing
Dim oSS As Inventor.SketchedSymbolDefinition
For Each oSS In oDoc2.SketchedSymbolDefinitions
If oSS.name = "Symbol004" Then
  Set oSSD = oSS
  Exit For
End If
Next

If Not oSSD Is Nothing Then
Dim oPunkt As Inventor.Point2d:        Set oPunkt = ThisApplication.TransientGeometry.CreatePoint2d(0, 0)
Call oSheet1.SketchedSymbols.Add(oSSD, oPunkt)
End If
End Sub

---

Gruß
Berno

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

---

Hat leider nicht mit Copy-Paste funktioniert.
Aber: Dank deinem Code hab ich den Fehler noch gefunden.

Hier der vollständige Code:

Code:

---

Private Sub getSymbol()
Dim oDoc1 As Inventor.DrawingDocument:        Set oDoc1 = ThisApplication.ActiveDocument
Dim oDoc2 As Inventor.DrawingDocument:        Set oDoc2 = ThisApplication.Documents.Open("C:\VorlageSymbole.idw")
Dim oSheet1 As Inventor.Sheet:                Set oSheet1 = oDoc1.Sheets(1)

Dim oSSD2 As Inventor.SketchedSymbolDefinition: Set oSSD2 = Nothing
Dim oSS As Inventor.SketchedSymbolDefinition
For Each oSS In oDoc2.SketchedSymbolDefinitions
If oSS.Name = "Symbol004" Then
  Set oSSD2 = oSS
  Exit For
End If
Next

If Not oSSD2 Is Nothing Then
Dim oSSD1 As Inventor.SketchedSymbolDefinition: Set oSSD1 = oSSD2.CopyTo(oDoc1, True)
Dim oPunkt As Inventor.Point2d:                Set oPunkt = ThisApplication.TransientGeometry.CreatePoint2d(0, 0)
Call oSheet1.SketchedSymbols.add(oSSD1, oPunkt)
End If
End Sub

---

Dennoch vielen Dank.

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

---

gerne :-)

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