| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: Broserknoten mit Benutzerdefinieter Eigneschaft überschreiben (1131 / mal gelesen)
|
Goose Mitglied Maschinenbautechniker / geb. Zerspanungsmechaniker Fachrichtung Frästechnik
Beiträge: 206 Registriert: 29.03.2007 IV2024 R2.1 CATIA V6 R2013x
|
erstellt am: 18. Feb. 2016 14:11 <-- editieren / zitieren --> Unities abgeben:
Hallo zusammen, wie müsste den ein Makro aussehen dass den Browserknoten in einer Baugruppe mit einer Benutzerdefinierten Eigenschaft die in den I-Properties hinterlegt ist füllt. Danke und Gruß Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Lothar Boekels Ehrenmitglied V.I.P. h.c. Dipl.-Ing. Maschinenbau und CAD-Trainer
Beiträge: 3829 Registriert: 15.02.2001 DELL Precision 7520 Win10Pro-64 Inventor mit Vault Professional 2024 --------------------- Während man es aufschiebt, verrinnt das Leben. Lucius Annaeus Seneca (ca. 4 v. Chr - 65 n. Chr.)
|
erstellt am: 22. Feb. 2016 20:43 <-- editieren / zitieren --> Unities abgeben: Nur für Goose
z.B. so: Code:
Dim sMsg As String Public Sub DisplayNameAufbereiten() ' Display Name lesbarer machen If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject And _ ThisApplication.ActiveDocumentType <> kPartDocumentObject And _ ThisApplication.ActiveDocumentType <> kPresentationDocumentObject And _ ThisApplication.ActiveDocumentType <> kDrawingDocumentObject Then 'MsgBox "Only Part or Assymbly or Drawing document", vbCritical Exit Sub End If ' Declare the Application object Dim oApplication As Inventor.Application
' Obtain the Inventor Application object. ' This assumes Inventor is already running. Set oApplication = ThisApplication ' Set a reference to the active document. ' This assumes a document is open. Dim oDoc As Document Set oDoc = oApplication.ActiveDocument Dim sFileName As String Dim iStart As Integer If ThisApplication.ActiveDocumentType = kDrawingDocumentObject Then sFileName = StandardModule.FileName(oDoc.FullFileName) oDoc.DisplayName = sFileName Else Dim sPartNumber As String Dim sDespription As String Dim sSubject As String Dim sTrennzeichen As String sPartNumber = Property_lesen(oDoc, "Part Number") sDespription = Property_lesen(oDoc, "Description") sSubject = Property_lesen(oDoc, "Subject") If Len(sPartNumber) = 0 Or Len(sDespription) = 0 Then sTrennzeichen = "" Else sTrennzeichen = " - " End If oDoc.DisplayName = sPartNumber & sTrennzeichen & sDespription If Len(sSubject) = 0 Then sTrennzeichen = "" Else sTrennzeichen = " - " End If oDoc.DisplayName = oDoc.DisplayName & sTrennzeichen & sSubject ' Überprüfung, ob Displayname, Partnumber und Dateiname harmonieren Dim sDisplayName As String sPartNumber = CStr(IPropEintraege.Property_lesen(oDoc, "Part Number")) sDisplayName = CStr(oDoc.DisplayName) 'MsgBox CStr(InStr(1, sDisplayName, sPartNumber, vbTextCompare)) sFileName = StandardModule.FileName(oDoc.FullFileName) ' Überprüfung, ob die Teilenummer im Display-Namen vorkommt If Not (InStr(1, sDisplayName, sPartNumber, vbTextCompare) = 1 And _ InStr(1, sFileName, sPartNumber, vbTextCompare) = 1) Then Debug.Print sDisplayName Debug.Print sPartNumber Debug.Print sFileName sMsg = "Teilenummer, Filename und Display-Namen sind nicht synchron!" & vbCrLf & vbCrLf & _ "Display-Name: " & vbTab & sDisplayName & vbCrLf & _ "Teilenummer : " & vbTab & sPartNumber & vbCrLf & _ "Filename : " & vbTab & sFileName & vbCrLf & _ vbCrLf & _ "sollen die Teilenummer und der Display-Name aus dem Filename generiert werden?" & _ vbCrLf If MsgBox(sMsg, vbYesNoCancel) = vbYes Then If oDoc.FileSaveCounter > 0 Then iStart = InStrRev(sFileName, ".", -1, vbTextCompare) sFileName = Left$(sFileName, iStart - 1) If Len(sDespription) = 0 Then sTrennzeichen = "" Else sTrennzeichen = " - " End If oDoc.DisplayName = sFileName & sTrennzeichen & sDespription Call IPropEintraege.Property_setzen(oDoc, "Part Number", sFileName) End If Else If Len(sDespription) = 0 Then sTrennzeichen = "" Else sTrennzeichen = " - " End If oDoc.DisplayName = sPartNumber & sTrennzeichen & sDespription End If End If End If Set oApplication = Nothing Set oDoc = Nothing End Sub
Lies das mal durch. Das Makro macht noch mehr. ------------------ mit freundlichem Gruß aus der Burggemeinde Brüggen Lothar Boekels ----------------------------------------------------- Wir unterstützen die Arbeit der Rettungshundestaffel des DRK in Viersen Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Goose Mitglied Maschinenbautechniker / geb. Zerspanungsmechaniker Fachrichtung Frästechnik
Beiträge: 206 Registriert: 29.03.2007 IV2024 R2.1 CATIA V6 R2013x
|
erstellt am: 23. Feb. 2016 08:06 <-- editieren / zitieren --> Unities abgeben:
|
Goose Mitglied Maschinenbautechniker / geb. Zerspanungsmechaniker Fachrichtung Frästechnik
Beiträge: 206 Registriert: 29.03.2007 IV2024 R2.1 CATIA V6 R2013x
|
erstellt am: 29. Feb. 2016 09:23 <-- editieren / zitieren --> Unities abgeben:
Zitat: Original erstellt von Lothar Boekels: z.B. so:[code] sPartNumber = Property_lesen(oDoc, "Part Number") sDespription = Property_lesen(oDoc, "Description") sSubject = Property_lesen(oDoc, "Subject")
Hallo, Bekomme die Fehlermeldung: Sub oder Function nicht definiert! Was mach ich da Falsch? Danke und Gruß Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Chris 31 Mitglied Konstrukteur und Mädchen für alles
Beiträge: 575 Registriert: 23.04.2013 Inventor 2013/2015 Windows 7 64 bit 16GB RAM nVidia Quadro 600
|
erstellt am: 29. Feb. 2016 13:39 <-- editieren / zitieren --> Unities abgeben: Nur für Goose
|
Lothar Boekels Ehrenmitglied V.I.P. h.c. Dipl.-Ing. Maschinenbau und CAD-Trainer
Beiträge: 3829 Registriert: 15.02.2001 DELL Precision 7520 Win10Pro-64 Inventor mit Vault Professional 2024 --------------------- Während man es aufschiebt, verrinnt das Leben. Lucius Annaeus Seneca (ca. 4 v. Chr - 65 n. Chr.)
|
erstellt am: 01. Mrz. 2016 13:20 <-- editieren / zitieren --> Unities abgeben: Nur für Goose
Code:
Public Function Property_lesen(oDoc As Document, sPropName As String) As Variant ' Liest eine Property. ' Ist die Property nicht vorhanden, so wird "" zurückgegeben. Property_lesen = "" If oDoc Is Nothing Then Return ' Obtain the PropertySets collection object Dim oPropSets As PropertySets Set oPropSets = oDoc.PropertySets Dim oProp As Property ' Iterate through all the PropertySets one by one using for loop Dim oPropSet As PropertySet For Each oPropSet In oPropSets For Each oProp In oPropSet 'Debug.Print oProp.Name If oProp.name = sPropName Then Property_lesen = oProp.Value Exit For End If Next Next
End Function
------------------ mit freundlichem Gruß aus der Burggemeinde Brüggen Lothar Boekels ----------------------------------------------------- Wir unterstützen die Arbeit der Rettungshundestaffel des DRK in Viersen Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Goose Mitglied Maschinenbautechniker / geb. Zerspanungsmechaniker Fachrichtung Frästechnik
Beiträge: 206 Registriert: 29.03.2007 IV2024 R2.1 CATIA V6 R2013x
|
erstellt am: 01. Mrz. 2016 15:19 <-- editieren / zitieren --> Unities abgeben:
|
dirk1608 Mitglied Dipl. Ing. Produktionstechnik
Beiträge: 144 Registriert: 06.09.2006 HP Z400 Intel Xeon CPU W3680 @ 3,33GHz 8 GB RAM NVIDIA Quadro 4000 Win7 Professional x64 Inventor 2010/2011/2012/2013
|
erstellt am: 02. Mrz. 2016 11:16 <-- editieren / zitieren --> Unities abgeben: Nur für Goose
Hallo, vielen Dank erstmal für den Code! Beim ausprobieren bekomme ich noch ein paar Fehler, ich denke es liegt daran, dass mir die folgeneden Funktionen noch fehlen: Call IPropEintraege.Property_setzen(odoc, "Part Number", sFileName) compile error: Method or data member not found das habe ich dann erstmal auskommentiert und bekomme bei: sFileName = StandardModule.FileName(odoc.FullFileName) den nächsten Fehler: Object reqiered Was fehlt mir da noch?
Funktioniert dieses Makro dann auch für Umbenennung der Browserknoten von Einzelteilen in der Baugruppe? Viele Grüße Dirk
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Lothar Boekels Ehrenmitglied V.I.P. h.c. Dipl.-Ing. Maschinenbau und CAD-Trainer
Beiträge: 3829 Registriert: 15.02.2001 DELL Precision 7520 Win10Pro-64 Inventor mit Vault Professional 2024 --------------------- Während man es aufschiebt, verrinnt das Leben. Lucius Annaeus Seneca (ca. 4 v. Chr - 65 n. Chr.)
|
erstellt am: 02. Mrz. 2016 18:29 <-- editieren / zitieren --> Unities abgeben: Nur für Goose
Code:
Public Sub Property_setzen(oDoc As Document, sPropName As String, vPropValue As Variant) ' Belegt eine Property mit einem Wert. ' Ist die Property nicht vorhanden, so wird sie angelegt. ' Obtain the PropertySets collection object Dim oPropSets As PropertySets Set oPropSets = oDoc.PropertySets Dim bPropertyDa As Boolean Dim oProp As Property bPropertyDa = False On Error Resume Next ' Iterate through all the PropertySets one by one using for loop ' and changing its value if found Dim oPropSet As PropertySet For Each oPropSet In oPropSets For Each oProp In oPropSet 'Debug.Print oProp.Name If oProp.name = sPropName Then oProp.Value = vPropValue bPropertyDa = True Exit For End If Next Next 'Property anlegen und Wert eintragen If Not bPropertyDa Then oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add vPropValue, sPropName 'oDoc.PropertySets.Item("User Defined Properties").Add vPropValue, sPropName End If On Error GoTo 0 End Sub
------------------ mit freundlichem Gruß aus der Burggemeinde Brüggen Lothar Boekels ----------------------------------------------------- Wir unterstützen die Arbeit der Rettungshundestaffel des DRK in Viersen Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Lothar Boekels Ehrenmitglied V.I.P. h.c. Dipl.-Ing. Maschinenbau und CAD-Trainer
Beiträge: 3829 Registriert: 15.02.2001 DELL Precision 7520 Win10Pro-64 Inventor mit Vault Professional 2024 --------------------- Während man es aufschiebt, verrinnt das Leben. Lucius Annaeus Seneca (ca. 4 v. Chr - 65 n. Chr.)
|
erstellt am: 02. Mrz. 2016 18:30 <-- editieren / zitieren --> Unities abgeben: Nur für Goose
|
Roland Schröder Ehrenmitglied V.I.P. h.c. Dr.-Ing. Maschinenbau, Entwicklung & Konstruktion von Spezialmaschinen
Beiträge: 13348 Registriert: 02.04.2004 AIP2013SP2.2 XPproSP2 MS-IntelliMouse-Optical SpacePilot DellM4600 2,13GHz 2GB FxGo1400 1920x1200 am Dock Dell2711
|
erstellt am: 02. Mrz. 2016 20:55 <-- editieren / zitieren --> Unities abgeben: Nur für Goose
Moin! Ist Dir klar, dass diese Umbenennung dann statisch ist? Wenn dieser Code nicht immer wieder neu angestoßen wird, z. B. auch weil er auf anderen Rechnern gar nicht vorhanden, bleiben diese Einträge später immer unverändert. Wenn man dann Komponenten in der Baugruppe tauscht, ist die Verwirrung u. U. groß. ------------------ Roland www.Das-Entwicklungsbuero.de It's not the hammer - it's the way you hit! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Ex-Mitglied
|
erstellt am: 02. Mrz. 2016 22:09
- Inhaltsloser Beitrag - |
Lothar Boekels Ehrenmitglied V.I.P. h.c. Dipl.-Ing. Maschinenbau und CAD-Trainer
Beiträge: 3829 Registriert: 15.02.2001 DELL Precision 7520 Win10Pro-64 Inventor mit Vault Professional 2024 --------------------- Während man es aufschiebt, verrinnt das Leben. Lucius Annaeus Seneca (ca. 4 v. Chr - 65 n. Chr.)
|
erstellt am: 03. Mrz. 2016 17:25 <-- editieren / zitieren --> Unities abgeben: Nur für Goose
|