| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: Schwerpunkt-Koordinaten relativ zu Baugruppe (1592 mal gelesen)
|
Charly Setter Ehrenmitglied V.I.P. h.c.
Beiträge: 11977 Registriert: 28.05.2002 Trau keiner Diva unter SP2....
|
erstellt am: 03. Sep. 2019 10:53 <-- editieren / zitieren --> Unities abgeben:
Moin Allerseits, ich benötige die Schwerpunktkoordinaten der Einzelteile (ipt) einer Baugruppe (mehrere Ebenen) als Excel-Export. In den Properties der Bauteile stehen ja nur die Koordinaten rel. zum Bauteilursprung. Seht ihr eine Möglichkeit dieses Probelm ohne großen Aufwand zu lösen? Gruß Mathias ------------------ Der vernünftige Mensch paßt sich der Welt an; der unvernünftige besteht auf dem Versuch, die Welt sich anzupassen. Deshalb hängt aller Fortschritt vom unvernünftigen Menschen ab. (George Bernard Shaw) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
freierfall Ehrenmitglied V.I.P. h.c. selbstst. techn. Zeichner
Beiträge: 11471 Registriert: 30.04.2004 Presion490 IV 11
|
erstellt am: 03. Sep. 2019 11:03 <-- editieren / zitieren --> Unities abgeben: Nur für Charly Setter
|
Charly Setter Ehrenmitglied V.I.P. h.c.
Beiträge: 11977 Registriert: 28.05.2002 Trau keiner Diva unter SP2....
|
erstellt am: 03. Sep. 2019 11:10 <-- editieren / zitieren --> Unities abgeben:
JA aber nicht die richtige Dichte / Materialdefinition... ------------------ Der vernünftige Mensch paßt sich der Welt an; der unvernünftige besteht auf dem Versuch, die Welt sich anzupassen. Deshalb hängt aller Fortschritt vom unvernünftigen Menschen ab. (George Bernard Shaw) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Roland Schröder Ehrenmitglied V.I.P. h.c. Dr.-Ing. Maschinenbau, Entwicklung & Konstruktion von Spezialmaschinen
Beiträge: 13115 Registriert: 02.04.2004 AIP2013SP2.2 XPproSP2 MS-IntelliMouse-Optical SpacePilot DellM4600 2,13GHz 2GB FxGo1400 1920x1200 am Dock Dell2711
|
erstellt am: 03. Sep. 2019 11:33 <-- editieren / zitieren --> Unities abgeben: Nur für Charly Setter
|
Charly Setter Ehrenmitglied V.I.P. h.c.
Beiträge: 11977 Registriert: 28.05.2002 Trau keiner Diva unter SP2....
|
erstellt am: 03. Sep. 2019 12:31 <-- editieren / zitieren --> Unities abgeben:
Zitat: Original erstellt von Roland Schröder: Tja, hättste mal ein Mastermodell gemacht!
Scherzkeks... Ich hab bei Dir auch noch keine Schrauben im Volumenmaster gesehen... ------------------ Der vernünftige Mensch paßt sich der Welt an; der unvernünftige besteht auf dem Versuch, die Welt sich anzupassen. Deshalb hängt aller Fortschritt vom unvernünftigen Menschen ab. (George Bernard Shaw) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 601 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 03. Sep. 2019 13:34 <-- editieren / zitieren --> Unities abgeben: Nur für Charly Setter
Hier mal mein erster Wurf in VBA. Während dem Tippen lese ich aber gerade das mit den mehreren Bgr-Ebenen-> das ist nicht enthalten (geht nur durch die Komp. der obersten Ebene) Code: Private Sub IAM_CenterOfMass() ' Schleife durch alle Komponenten einer Bgr ' es wird jeweils der Schwerpunkt gelesen ' KraBBy 03.09.2019 Dim oDoc As AssemblyDocument Set oDoc = ThisApplication.ActiveDocument Dim oOccs As ComponentOccurrences Set oOccs = oDoc.ComponentDefinition.Occurrences 'Ausgabetext vorbereiten Dim sText() As String ReDim sText(1) sText(0) = oDoc.DisplayName sText(1) = "X ; Y ; Z ; Name" 'Header der Tabelle Dim oOcc As ComponentOccurrence Dim oPt As Point For Each oOcc In oOccs ReDim Preserve sText(UBound(sText) + 1) 'Array vergrößern sText(UBound(sText)) = GetCenterOfGrav(oOcc) Next Call Write2File(sText) 'MsgBox "done", , "Fertig" End Sub Private Function GetCenterOfGrav(Oc As ComponentOccurrence) As String 'Koordinaten vom Schwerpunkt als String X; Y; Z 'Werte in mm Dim t As String If Not Oc.Reference Then With Oc.MassProperties.CenterOfMass t = .x * 10 & "; " t = t & .y * 10 & "; " t = t & .z * 10 & "; " t = t & Oc.Name End With Else t = " " & "; " & "Reference " & "; " & " " t = t & "; " & Oc.Name End If GetCenterOfGrav = t 'Rückgabewert End Function Private Sub Write2File(sLines() As String, Optional sFile As String = "C:\Temp\Schwerpunkte.csv") ' Ausgabe in Datei ' 'Const sFile As String = "C:\Temp\Schwerpunkte.csv" ' Datei schreiben Dim f f = FreeFile 'liefert nächsten freien Index Open sFile For Output As #f Write #f, Now() 'Print #f, ".Name; .DisplayName; .Value " 'Header schreiben Write #f, 'Leerzeile Dim i As Long For i = LBound(sLines) To UBound(sLines) Print #f, sLines(i) Next Close #f 'Unterschied von Write / Print siehe Hilfe 'Ausgabedatei ggf. öffnen Dim ret As VbMsgBoxResult ret = MsgBox("Erzeugte Datei öffnen?", vbYesNo + vbQuestion, "Fertig") If vbYes = ret Then Dim ws As Object Set ws = CreateObject("WScript.Shell") ws.Run Chr(34) & sFile & Chr(34) 'mit Shell() habe ich es nicht geschafft... Set ws = Nothing 'Aufräumen End If End Sub
------------------ Gruß KraBBy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 601 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 03. Sep. 2019 14:12 <-- editieren / zitieren --> Unities abgeben: Nur für Charly Setter
Update, jetzt mit Schleife durch Unterbaugruppen Code: Private Sub IAM_CenterOfMass() ' Schleife durch alle Komponenten einer Bgr ' es wird jeweils der Schwerpunkt gelesen ' KraBBy 03.09.2019 - Update Dim oDoc As AssemblyDocument Set oDoc = ThisApplication.ActiveDocument Dim oOccs As ComponentOccurrences Set oOccs = oDoc.ComponentDefinition.Occurrences 'Ausgabetext vorbereiten Dim sText() As String ReDim sText(1) sText(0) = oDoc.DisplayName sText(1) = "X ; Y ; Z ; Asm-Level ; Name" 'Header der Tabelle 'Schleife durch Komponenten, rekursiv Call SubOcc_recursive(sText, oOccs) Call Write2File(sText) 'MsgBox "done", , "Fertig" End Sub Private Sub SubOcc_recursive(ByRef sText() As String, oCs As ComponentOccurrences) Dim oOcc As ComponentOccurrence For Each oOcc In oCs ReDim Preserve sText(UBound(sText) + 1) 'Array vergrößern sText(UBound(sText)) = GetCenterOfGrav(oOcc) If Not 0 = oOcc.SubOccurrences.Count Then Call SubOcc_recursive(sText, oOcc.SubOccurrences) 'Recursion End If Next End Sub Private Function GetCenterOfGrav(oC As ComponentOccurrence) As String 'Koordinaten vom Schwerpunkt als String X; Y; Z 'Werte in mm Dim t As String On Error Resume Next 'hatte ein Problem mit ipt ohne Volumen... If Not oC.Reference Then With oC.MassProperties.CenterOfMass t = .x * 10 t = t & "; " t = t & .y * 10 t = t & "; " t = t & .z * 10 t = t & "; " t = t & oC.OccurrencePath.Count 'entspricht dem "Bgr.-Level" t = t & "; " t = t & oC.Name End With Else t = " " & "; " & "Reference " & "; " & " " & "; " & " " t = t & "; " & oC.Name End If On Error GoTo 0 GetCenterOfGrav = t 'Rückgabewert End Function Private Sub Write2File(sLines() As String, Optional sFile As String = "C:\Temp\Schwerpunkte.csv") ' Ausgabe in Datei ' 'Const sFile As String = "C:\Temp\Schwerpunkte.csv" ' Datei schreiben Dim f f = FreeFile 'liefert nächsten freien Index Open sFile For Output As #f Write #f, Now() Write #f, 'Leerzeile Dim i As Long For i = LBound(sLines) To UBound(sLines) Print #f, sLines(i) Next Close #f 'Unterschied von Write / Print siehe Hilfe 'Ausgabedatei ggf. öffnen Dim ret As VbMsgBoxResult ret = MsgBox("Erzeugte Datei öffnen?", vbYesNo + vbQuestion, "Fertig") If vbYes = ret Then Dim ws As Object Set ws = CreateObject("WScript.Shell") ws.Run Chr(34) & sFile & Chr(34) 'mit Shell() habe ich es nicht geschafft... Set ws = Nothing 'Aufräumen End If End Sub
------------------ Gruß KraBBy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Charly Setter Ehrenmitglied V.I.P. h.c.
Beiträge: 11977 Registriert: 28.05.2002 Trau keiner Diva unter SP2....
|
erstellt am: 03. Sep. 2019 21:05 <-- editieren / zitieren --> Unities abgeben:
Moin Krabby, das sieht verdammt gut aus, vielen Dank... Ich hatte die Befürchtung, das die DIVA die Schwerpunktlage rel. zum Bauteilkoordinatensystem rausschreibt. Aber es sieht so aus, als ob tatsächlich die Schwerpunktlage rel. zum Koordinatensystem der übergeordneten BG angegeben wird => genau was ich brauche. Jetzt muß ich die Ausgabe noch etwas anpassen, und ich habe was ich brauche.... Wenn Du mal in die Gegend Kiel kommen solltest, steht ein Bier für Dich kalt. Gruß Mathias ------------------ Der vernünftige Mensch paßt sich der Welt an; der unvernünftige besteht auf dem Versuch, die Welt sich anzupassen. Deshalb hängt aller Fortschritt vom unvernünftigen Menschen ab. (George Bernard Shaw) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Frank_Schalla Ehrenmitglied CAD_SYSTEMBETREUER
Beiträge: 1731 Registriert: 06.04.2002 DELL M6800 Cad Admin Methodikentwickler 3D
|
erstellt am: 04. Sep. 2019 10:20 <-- editieren / zitieren --> Unities abgeben: Nur für Charly Setter
|
Charly Setter Ehrenmitglied V.I.P. h.c.
Beiträge: 11977 Registriert: 28.05.2002 Trau keiner Diva unter SP2....
|
erstellt am: 04. Sep. 2019 18:08 <-- editieren / zitieren --> Unities abgeben:
Hallo Frank, auch ein netter Ansatz, und schön relaisiert. Nur iteriert´s nicht in die Tiefe des Baugruppendschungels Danke. ------------------ Der vernünftige Mensch paßt sich der Welt an; der unvernünftige besteht auf dem Versuch, die Welt sich anzupassen. Deshalb hängt aller Fortschritt vom unvernünftigen Menschen ab. (George Bernard Shaw) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |