| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: Benutzerdefinierte I-Prop mittels Makro überschreiben (1730 mal gelesen)
|
Smoke2004 Mitglied
Beiträge: 21 Registriert: 19.09.2007 Inventor 2008 SP1 Dell Precision PWS380 Intel(R) Pentium(R) CPU 3.20GHz 3.19GHz, 3,50GB RAM<P>Windows XP Pro Version 2002 SP2
|
erstellt am: 14. Okt. 2007 10:13 <-- editieren / zitieren --> Unities abgeben:
Guten Morgen an alle. Ich hätte da eine kurze Frage, kann mir jemand sagen was ich falsch mache? Ich möchte meine Benutzerdef. I-Prop mittels Makro überschreiben. Ich holle den Wert aus einer Excelliste nur er schreibt mir diesen Wert nicht rein ich hoffe es kann mir einer von euch da weiter helfen. code: oDoc.PropertySets(4).Item("Änderung").Value = xlWS.Application.Cells(32, 3) So habe ich mir gedacht das es Funktioniert, bei den anderen Props funktioniert es nur nicht bei Benutzerdef. warum nicht. Vielen Dank für eure Hilfe Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RODER Mitglied Maschineningenieur
Beiträge: 494 Registriert: 04.01.2003
|
erstellt am: 15. Okt. 2007 08:24 <-- editieren / zitieren --> Unities abgeben: Nur für Smoke2004
Morgen Smoke oder wie du auch heisst, stimmen die Formate der Werte die du aus dem Excel hohlst mit der Definition überein? Sonst kannst du ja sicherheitshalber zu String (also Text) formatieren. Habe in VBA nicht die Grosse Erfahrung und das Wissen, dass ich dir sagen kann ob der Fehler an deinem Code liegt oder nicht. ------------------ Grüsse, Toni Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
SEHER Mitglied Systemanalytiker
Beiträge: 1203 Registriert: 13.03.2001 Inventor 2 bis 2022 häufig wechselnder Rechnerverkehr
|
erstellt am: 15. Okt. 2007 08:32 <-- editieren / zitieren --> Unities abgeben: Nur für Smoke2004
|
Speedy.X Mitglied Dipl.Ing.
Beiträge: 45 Registriert: 17.05.2005
|
erstellt am: 15. Okt. 2007 12:35 <-- editieren / zitieren --> Unities abgeben: Nur für Smoke2004
Hallo Smoke2004! Stelle doch erst mal den IST-Zustand fest. Wenn Du nichts eigenes hast, empfehle ich Dir ein paar Themen drunter "I-Properties" den Code von Igor. Danach z.B.: Dim EigI As String = "{D5CDD505-2E9C-101B-9397-08002B2CF9AE}" Dim iP002 as String iP002= xlWS.Application.Cells(32, 3) oDoc.PropertySets.Item(EigI).Item("Änderung").Value = iP002 Damit solltest Du doch sehen können welche Werte übergeben werden. Vielleicht wäre es auch vorteilhaft, keine Umlaute zu verwenden. Gruß Rainer
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Smoke2004 Mitglied
Beiträge: 21 Registriert: 19.09.2007 Inventor 2008 SP1 Dell Precision PWS380 Intel(R) Pentium(R) CPU 3.20GHz 3.19GHz, 3,50GB RAM<P>Windows XP Pro Version 2002 SP2
|
erstellt am: 16. Okt. 2007 09:11 <-- editieren / zitieren --> Unities abgeben:
JA danke für eure Anworten. Ich hole meine Benutz.def. I-Prop zum Beispiel von Inventor heraus und schreib sie ins Excel das funktioniert wunderbar nur der umgekehrte Weg geht garnicht habe echt keinen Schimmer warum habe auch schon andere Beiträge gelesen nur ich habe noch keine Anwort gefunden die mir weiter helfen kann.
Hier Code: Public Sub Auslesen() Dim XL As Object Dim xlWB As Object Dim xlWS As Object Dim oDoc As PartDocument Set oDoc = ThisApplication.ActiveDocument Dim pfad As String pfad = "I:\Makro\" + oDoc.PropertySets(3).Item("Part Number").Value Set XL = CreateObject("Excel.Application") Set xlWB = XL.Workbooks.Open(pfad) Set xlWS = xlWB.ActiveSheet XL.Application.Visible = True On Error Resume Next If oDoc.DocumentType = kPartDocumentObject Or oDoc.DocumentType = kPartDocumentObject Then oDoc.PropertySets(3).Item("Part Number").Value = xlWS.Application.Cells(9, 3) oDoc.PropertySets(3).Item("Description").Value = xlWS.Application.Cells(11, 3) oDoc.PropertySets(3).Item("Vendor").Value = xlWS.Application.Cells(17, 3) oDoc.PropertySets(3).Item("Catalog Web Link").Value = xlWS.Application.Cells(22, 3) oDoc.PropertySets(3).Item("Material").Value = xlWS.Application.Cells(25, 3) oDoc.PropertySets(3).Item("Cost Center").Value = xlWS.Application.Cells(23, 3) oDoc.PropertySets(3).Item("Project").Value = xlWS.Application.Cells(13, 3) oDoc.PropertySets(1).Item("Revision Number").Value = xlWS.Application.Cells(12, 3) oDoc.PropertySets(1).Item("Comments").Value = xlWS.Application.Cells(32, 3) 'Benutzerdefinierte oDoc.PropertySets(4).Item("Änderung").Value = xlWS.Application.Cells(33, 3) oDoc.PropertySets(4).Item("Datum").Value = xlWS.Application.Cells(34, 3) End If On Error GoTo 0 XL.Application.Quit Set xlWS = Nothing Set xlWB = Nothing Set XL = Nothing End Sub Das ist der Code den ich hier verwende( Habe ich mir aus einigen Beiträgen zusammen gebaut)
Alle anderen i-Prop Funktionieren nur die Benutzerdef. nicht. Ich hoffe das mir einer von euch helfen kann
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
daywa1k3r Moderator Softwareentwickler
Beiträge: 3497 Registriert: 01.08.2002 Alienware m17x, Win7, Inventor2012
|
erstellt am: 16. Okt. 2007 09:42 <-- editieren / zitieren --> Unities abgeben: Nur für Smoke2004
Zitat: Original erstellt von Smoke2004: Ich hoffe das mir einer von euch helfen kann
Dein Programm funktioniert ab dem ersten Umlaut nicht. Probier mal ohne Umlaute im PropertyName. Könnte sein, denn du ignorierst geschickt die Fehlerbehandlung, so wird die Zeile
Code:
oDoc.PropertySets(4).Item("Datum").Value = xlWS.Application.Cells(34, 3)
niemals aufgerufen, obwohl die theoretisch funktionieren könnte. ------------------ Grüße Igor
FX64 Software Solutions Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Speedy.X Mitglied Dipl.Ing.
Beiträge: 45 Registriert: 17.05.2005
|
erstellt am: 16. Okt. 2007 09:55 <-- editieren / zitieren --> Unities abgeben: Nur für Smoke2004
Hallo Smoke2004, also auf's Wesentliche reduziert hab ich es schnell mal getestet: Code:
Sub LiesXLS1() Dim XL As Object Dim xlWB As Object Dim xlWS As Object Dim oDoc As PartDocument Dim pfad As String Dim Wert1 As String Dim Wert2 As String pfad = "C:\Ablage\Work\X2Inv1.xls" Set XL = CreateObject("Excel.Application") Set xlWB = XL.Workbooks.Open(pfad) Set xlWS = xlWB.ActiveSheet XL.Application.Visible = True Wert1 = xlWS.Application.Cells(11, 2) Wert2 = xlWS.Application.Cells(11, 3) XL.Application.Quit Set xlWS = Nothing Set xlWB = Nothing Set XL = Nothing End Sub
Es funktioniert bei mir. Das Problem könnte also in der Übergabe und der Typkonvertierung liegen. Gruß Rainer Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Smoke2004 Mitglied
Beiträge: 21 Registriert: 19.09.2007 Inventor 2008 SP1 Dell Precision PWS380 Intel(R) Pentium(R) CPU 3.20GHz 3.19GHz, 3,50GB RAM<P>Windows XP Pro Version 2002 SP2
|
erstellt am: 16. Okt. 2007 09:58 <-- editieren / zitieren --> Unities abgeben:
Dut mir leid habe jezuz absolut keinen Schimmer mehr. Du sagst ab den ersten Umlaut geht mein Programm nicht mehr? Habe ehrlich gesagt keine Meldung bekommen wenn ich es Ausführe werden diese irgendwo angeführt? Nur da habe ich eine Frage warum funktioniert der umgekehrte Weg? Hier der Code dazu: Public Sub Auslesen() Dim XL As Object Dim xlWB As Object Dim xlWS As Object Dim pfad As String pfad = "I:\Makro\Vorlage.xls" Dim odoc As PartDocument 'Definition Inventor Set odoc = ThisApplication.ActiveDocument Dim IV As Object 'Inventor wird als Objekt im Excel definiert, damit darauf zugegriffen werden kann Set IV = GetObject(, "inventor.application") Dim IVDatei As String 'holt sich den kompletten Dateiname der in Inventor geöffneten Baugruppe IVDatei = IV.ActiveDocument.FullFileName If odoc.FullFileName = "" Then MsgBox "Keine Inventordatei geöffnet!": Exit Sub Set XL = CreateObject("Excel.Application") Set xlWB = XL.Workbooks.Open(pfad) Set xlWS = xlWB.ActiveSheet XL.Application.Visible = True On Error Resume Next '--------Inventor - Zusammenfassungsinformationen-------- xlWS.Application.Cells(6, 2).Value = odoc.PropertySets(1).Item("Revision Number").Value xlWS.Application.Cells(24, 2).Value = odoc.PropertySets(1).Item("Comments").Value 'Kommente '--------Inventor - Zus.-fassungsinfo f. Dokument--------- '--------Design Tracking - Eigenschaften xlWS.Application.Cells(4, 2).Value = odoc.PropertySets(3).Item("Part Number").Value 'Ident.-Nummer xlWS.Application.Cells(7, 2).Value = odoc.PropertySets(3).Item("Project").Value 'Projekt xlWS.Application.Cells(16, 2).Value = odoc.PropertySets(3).Item("Material").Value xlWS.Application.Cells(14, 2).Value = odoc.PropertySets(3).Item("Catalog Web Link").Value 'Art.Nr. xlWS.Application.Cells(5, 2).Value = odoc.PropertySets(3).Item("Description").Value xlWS.Application.Cells(13, 2).Value = odoc.PropertySets(3).Item("Vendor").Value 'Lieferant xlWS.Application.Cells(8, 2).Value = odoc.PropertySets(3).Item("Stock Number").Value 'Halbzeug xlWS.Application.Cells(15, 2).Value = odoc.PropertySets(3).Item("Mass").Value '--------Inventor - Benutzerdefinierte Eigenschaften xlWS.Application.Cells(30, 1).Value = odoc.PropertySets(4).Item("1.1_Änd.Nr.").Value If odoc.PropertySets(4).Item("1.2_Dat").Value = "01.01.1601" Then odoc.PropertySets(4).Item("1.2_Dat").Value = " " xlWS.Application.Cells(30, 2).Value = odoc.PropertySets(4).Item("1.2_Dat").Value xlWS.Application.Cells(30, 3).Value = odoc.PropertySets(4).Item("1.3_Nam").Value xlWS.Application.Cells(30, 4).Value = odoc.PropertySets(4).Item("1.0_Rev").Value xlWS.Application.Cells(31, 1).Value = odoc.PropertySets(4).Item("2.1_Änd.Nr.").Value If odoc.PropertySets(4).Item("2.2_Dat").Value = "01.01.1601" Then odoc.PropertySets(4).Item("2.2_Dat").Value = " " xlWS.Application.Cells(31, 2).Value = odoc.PropertySets(4).Item("2.2_Dat").Value xlWS.Application.Cells(31, 3).Value = odoc.PropertySets(4).Item("2.3_Nam").Value xlWS.Application.Cells(31, 4).Value = odoc.PropertySets(4).Item("2.0_Rev").Value xlWS.Application.Cells(32, 1).Value = odoc.PropertySets(4).Item("3.1_Änd.Nr.").Value If odoc.PropertySets(4).Item("3.2_Dat").Value = "01.01.1601" Then odoc.PropertySets(4).Item("3.2_Dat").Value = " " xlWS.Application.Cells(32, 2).Value = odoc.PropertySets(4).Item("3.2_Dat").Value xlWS.Application.Cells(32, 3).Value = odoc.PropertySets(4).Item("3.3_Nam").Value xlWS.Application.Cells(32, 4).Value = odoc.PropertySets(4).Item("3.0_Rev").Value xlWS.Application.Cells(33, 1).Value = odoc.PropertySets(4).Item("4.1_Änd.Nr.").Value If odoc.PropertySets(4).Item("4.2_Dat").Value = "01.01.1601" Then odoc.PropertySets(4).Item("4.2_Dat").Value = " " xlWS.Application.Cells(33, 2).Value = odoc.PropertySets(4).Item("4.2_Dat").Value xlWS.Application.Cells(33, 3).Value = odoc.PropertySets(4).Item("4.3_Nam").Value xlWS.Application.Cells(33, 4).Value = odoc.PropertySets(4).Item("4.0_Rev").Value xlWS.Application.Cells(34, 1).Value = odoc.PropertySets(4).Item("5.1_Änd.Nr.").Value If odoc.PropertySets(4).Item("5.2_Dat").Value = "01.01.1601" Then odoc.PropertySets(4).Item("5.2_Dat").Value = " " xlWS.Application.Cells(34, 2).Value = odoc.PropertySets(4).Item("5.2_Dat").Value xlWS.Application.Cells(34, 3).Value = odoc.PropertySets(4).Item("5.3_Nam").Value xlWS.Application.Cells(34, 4).Value = odoc.PropertySets(4).Item("5.0_Rev").Value 'xlWS.Application.Cells(10, 2).Value = odoc.PropertySets(4).Item("Hersteller").Value 'xlWS.Application.Cells(11, 2).Value = odoc.PropertySets(4).Item("Artikelnummer").Value '----------------------------------- xlWS.SaveAs "I:\Makro\" + odoc.PropertySets(3).Item("Part Number").Value 'Hier wird das aktuelle Fenster gespeichert On Error GoTo 0 'XL.Application.Quit 'Schließt das Fenster 'Löst die Verbindung von XL Set xlWS = Nothing Set xlWB = Nothing Set XL = Nothing End Sub Kannst du mir Sagen warum das funkioniert Danke Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Smoke2004 Mitglied
Beiträge: 21 Registriert: 19.09.2007 Inventor 2008 SP1 Dell Precision PWS380 Intel(R) Pentium(R) CPU 3.20GHz 3.19GHz, 3,50GB RAM<P>Windows XP Pro Version 2002 SP2
|
erstellt am: 16. Okt. 2007 10:02 <-- editieren / zitieren --> Unities abgeben:
Zitat: Original erstellt von Speedy.X: Hallo Smoke2004,also auf's Wesentliche reduziert hab ich es schnell mal getestet: Code:
Sub LiesXLS1() Dim XL As Object Dim xlWB As Object Dim xlWS As Object Dim oDoc As PartDocument Dim pfad As String Dim Wert1 As String Dim Wert2 As String pfad = "C:\Ablage\Work\X2Inv1.xls" Set XL = CreateObject("Excel.Application") Set xlWB = XL.Workbooks.Open(pfad) Set xlWS = xlWB.ActiveSheet XL.Application.Visible = True Wert1 = xlWS.Application.Cells(11, 2) Wert2 = xlWS.Application.Cells(11, 3) XL.Application.Quit Set xlWS = Nothing Set xlWB = Nothing Set XL = Nothing End Sub
Es funktioniert bei mir. Das Problem könnte also in der Übergabe und der Typkonvertierung liegen. Gruß Rainer
Ja aber die Anderen Werte funktionieren ja Wunderbar z.B Comments, nur die Benutzerdef. macht er garnicht( liegt das echt nur an die Umlaute) Aber wenn ich nur die Werte nehme ohne Unlaute macht er a nix. Meine Benutzerdef. habe ich ganz Normal als Text definiert!
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
rtend12 Mitglied Dipl.-Ing. (FH) Maschinenbau / Konstrukteur
Beiträge: 436 Registriert: 21.07.2004 Catia V5 (R16SP5, B18SP5) VB.Net 2003
|
erstellt am: 16. Okt. 2007 20:18 <-- editieren / zitieren --> Unities abgeben: Nur für Smoke2004
Hallo Smoke2004, es liegt wahrscheinlich nicht am Umlaut, bei mir gehts auch mit "ä". Du solltest dir mal deinen Code anschauen. "On Error Resume Next" führt dazu, dass du keine Fehlermeldung bekommst, der Code wird, wenn ein Fehler auftritt einfach fortgesetzt. Du schreibst: Zitat: xlWS.Application.Cells(30, 1).Value = odoc.PropertySets(4).Item("1.1_Änd.Nr.").Valueund oDoc.PropertySets(4).Item("Änderung").Value = xlWS.Application.Cells(33, 3)
Um einem iProp einen Wert zuzuweisen, muß dieses iProp schon vorhanden sein. Hast du ewin iProp "Änderung"? Gruß Reinhard Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Smoke2004 Mitglied
Beiträge: 21 Registriert: 19.09.2007 Inventor 2008 SP1 Dell Precision PWS380 Intel(R) Pentium(R) CPU 3.20GHz 3.19GHz, 3,50GB RAM<P>Windows XP Pro Version 2002 SP2
|
erstellt am: 17. Okt. 2007 07:45 <-- editieren / zitieren --> Unities abgeben:
Guten Morgen! Sorry wenn ich mich unklar ausgedrückt habe, das mit den I-Propertys war nur ein Beispiel Ja ich habe schon kontrolliert ob ich wohl alle meine i-props angelegt habe und richtigt geschrieben habe. Das ist nicht das Problem. Das mit den Fehlermeldungungen wusste ich nicht sogut kenne ich mich leider auch nicht aus in VB. Kann mir trotzdem bitte einer bei meinen Problem helfen? Zusammengefasst: Ich möchte mittels einen Makro meine Benutzerdefinierten I-Props überschreiben den Wert dazu holle ich vorher aus einer Excel-Tabelle. Ich habe es schon Geschafft (mit sehr viel Hilfe dieses Forums) das ich die Werte von Inventor in die Excelliste schreibe. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
lbcad Ehrenmitglied V.I.P. h.c. Dipl.-Ing. Maschinenbau und CAD-Trainer
Beiträge: 3794 Registriert: 15.02.2001
|
erstellt am: 17. Okt. 2007 08:57 <-- editieren / zitieren --> Unities abgeben: Nur für Smoke2004
|
Smoke2004 Mitglied
Beiträge: 21 Registriert: 19.09.2007 Inventor 2008 SP1 Dell Precision PWS380 Intel(R) Pentium(R) CPU 3.20GHz 3.19GHz, 3,50GB RAM<P>Windows XP Pro Version 2002 SP2
|
erstellt am: 17. Okt. 2007 09:20 <-- editieren / zitieren --> Unities abgeben:
Tut mir leid ich weis ich bin lässtig aber kannst du mir kurz sagen wie dein Makro macht, versteh nicht ganz wie es funktioniert. bzw wo es meinen Wert von meine Excel Liste holt, Ich will meine I-prop. nicht neu anlegen sie sind Ja schon Vorhanden.Wir benutzen sie für unser Anderungswesen Änder_Nr / Text /91000 Datum/ Date/17.10.2007 Und ich möchte mein Datum (17.10.2007) mittels Makro und Excel einfügen bzw Änder_Nr. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
lbcad Ehrenmitglied V.I.P. h.c. Dipl.-Ing. Maschinenbau und CAD-Trainer
Beiträge: 3794 Registriert: 15.02.2001
|
erstellt am: 19. Okt. 2007 09:58 <-- editieren / zitieren --> Unities abgeben: Nur für Smoke2004
|
Smoke2004 Mitglied
Beiträge: 21 Registriert: 19.09.2007 Inventor 2008 SP1 Dell Precision PWS380 Intel(R) Pentium(R) CPU 3.20GHz 3.19GHz, 3,50GB RAM<P>Windows XP Pro Version 2002 SP2
|
erstellt am: 25. Okt. 2007 12:47 <-- editieren / zitieren --> Unities abgeben:
|