---

Hallo,
ich hab mir diesen Code aus der Hilfe kopiert, nur funktioniert dieser nur teilweise.
Das erstellen des Punktes funzt, aber aktualisiert wird er leider nicht.
Kann mir da jemand helfen?

Public Sub WorkPointAtMassCenter()
    ' Check to make sure a part document is active.
    If ThisApplication.ActiveDocumentType <> kPartDocumentObject Then
        MsgBox "A part document must be active."
        Exit Sub
    End If

    ' Set a reference to the active document.
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument

    ' Get the Center of Mass.
    Dim oCenterOfMass As Point
    Set oCenterOfMass = oDoc.ComponentDefinition.MassProperties.CenterOfMass

    ' Check to see if a work point for center of mass already exists.
    ' This uses the name of the work feature to identify it.
    On Error Resume Next
    Dim oWorkPoint As WorkPoint
    Set oWorkPoint = oDoc.ComponentDefinition.WorkPoints.Item("Center Of Mass")
    If Err.Number = 0 Then
        Dim oFixedDef As FixedWorkPointDef
        Set oFixedDef = oWorkPoint.Definition

        oFixedDef.Point = oCenterOfMass
        oDoc.Update
    Else
        ' Create a new workpoint at the location of the center of mass.
        Set oWorkPoint = oDoc.ComponentDefinition.WorkPoints.AddFixed(oCenterOfMass)

        ' Rename the work point.
        oWorkPoint.Name = "Center Of Mass"
    End If
End Sub

------------------
Gruß
Hans-Peter
Der Wahnsinn in Sachen Musik.

   Das Saxregister
  

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

---

Hallo Hans-Peter!
Das ursprüngliche Makro ist nicht für eine Aktualisierung ausgelegt. Das mußt Du selbst noch an ein Ereignis hängen und einbauen.
Sei aber vorsichtig mit der Verwendung!
Ich hatte im Support schon einige "Gespenster" mit Dateien, in denen der fixierte Arbeitspunkt am Schwerpunkt war. Nach dem Löschen des AP war die Datei wieder in Ordnung.
Gebranntes Kind ...

------------------
lg      
Tom

...so geht mein Boot manchmal unter...

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

---

Hallo Tom,
der Punkt soll sich auch nicht automatisch korrigieren, sondern nur mit Makrodurchlauf.
Aber da dürfte im Code etwas nicht ganz stimmen, nur weiß ich nicht was.

------------------
Gruß
Hans-Peter
Der Wahnsinn in Sachen Musik.

   Das Saxregister
  

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

---

Zitat:

---

Original erstellt von SHP:
Das erstellen des Punktes funzt, aber aktualisiert wird er leider nicht.

---

Kann ich nicht bestätigen.

------------------
Grüße daywa1k3r

FX64 Software Solutions

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

---

Hallo,

bei mir funktioniert der Code.

Gruß
Reinhard

[Diese Nachricht wurde von rtend12 am 27. Okt. 2006 editiert.]

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

---

@all
ok, ich hab nicht alles geschrieben.
Im BT funzt der Code, weil aber in der Hilfe steht,

This sample demonstrates creating a fixed work point and edit its position. I does this by computing the the center of mass of the part or assembly and creating a work point at that position. Subsequent runs of the sample reposition the work point at the new center of mass.

hab den Code mal dahingehend geändert, und da funzt er leider nicht.

Public Sub WorkPointAtMassCenter()
    ' Check to make sure a part document is active.
    'If ThisApplication.ActiveDocumentType <> kPartDocumentObject Then
    '    MsgBox "A part document must be active."
    '    Exit Sub
    'End If

    ' Set a reference to the active document.
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument

    ' Get the Center of Mass.
    Dim oCenterOfMass As Point
    Set oCenterOfMass = oDoc.ComponentDefinition.MassProperties.CenterOfMass

    ' Check to see if a work point for center of mass already exists.
    ' This uses the name of the work feature to identify it.
    On Error Resume Next
    Dim oWorkPoint As WorkPoint
    Set oWorkPoint = oDoc.ComponentDefinition.WorkPoints.Item("Center Of Mass")
    If Err.Number = 0 Then
        Dim oFixedDef As FixedWorkPointDef
        Set oFixedDef = oWorkPoint.Definition

        oFixedDef.Point = oCenterOfMass
        oDoc.Update
    Else
        ' Create a new workpoint at the location of the center of mass.
        Set oWorkPoint = oDoc.ComponentDefinition.WorkPoints.AddFixed(oCenterOfMass)

        ' Rename the work point.
        oWorkPoint.Name = "Center Of Mass"
    End If
End Sub

Nachtrag:
hier lag der Hund begraben:
Dim oFixedDef As AssemblyWorkPointDef

------------------
Gruß
Hans-Peter 
Der Wahnsinn in Sachen Musik.

   Das Saxregister
     

[Diese Nachricht wurde von SHP am 27. Okt. 2006 editiert.]

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

---

Zitat:

---

Original erstellt von SHP:
Nachtrag:
hier lag der Hund begraben:
Dim oFixedDef As AssemblyWorkPointDef

---

Na dann, wuff! 

------------------
Grüße daywa1k3r

FX64 Software Solutions

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

---

Moin!

Ich will mir den obigen Code für die Verwendung im ipt ein bisschen erweitern, und zwar sollen die Schwerpunktkoordinaten auch kurz als Zahlenwerte angezeigt werden. Also MsgBox, so weit bin ich schon; ich scheitere allerdings am richtigen Format für die gewünschte Information.

Dieser Code geht nicht, sobald ich (wie gezeigt, was aber falsch ist) versuche, zu dem Titel auch die zuvor ermittelten Koordinaten zur Anzeige zu bringen:
"""
' Get and display the Center of Mass.
    Dim oCenterOfMass As Point
    Set oCenterOfMass = oDoc.ComponentDefinition.MassProperties.CenterOfMass
    MsgBox "Schwerpunktkoordinaten:" & oCenterOfMass
"""

Wie schreibe ich das richtg?

------------------
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

---

Hallo

CenterOfMass ist ein Objekt, das man so nicht direkt in einemer MessageBox verwenden kann. Eine MessageBox versteht nur Strings.
Die einzelnen Koordinaten X, Y und Z sind Zahlen, das geht zwar, ist aber unsauber. Eine Möglichkeit:

Code:

---

Dim sX As String
Dim sY As String
Dim sZ As String

sX =  CStr(Round(oCenterOfMass.X, 2))
sY =  CStr(Round(oCenterOfMass.Y, 2))
sZ =  CStr(Round(oCenterOfMass.Z, 2))

MsgBox "Schwerpunktkoordinaten:" & sX & ", " & sY & ", " & sZ

---

------------------
MfG
Ralf

RKW Solutions GmbH
www.RKW-Solutions.com

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

---

Sehr schön, Danke!

Läuft auch schon 

------------------
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

---

Moin!

Ich benötige im derzeitigen Projekt eigentlich nur die mit der obigen Hilfe verwirklichte Anzeige der Koordinaten zu Kontrollzwecken, ohne dafür immer umständlich in den iProperties gehen zu müssen. Und da der erzeugte Arbeitspunkt sich nicht automatisch aktualisiert, würde ich gern wählbar machen, ob er überhaupt gesetzt wird.

Die entsprechende Zeile im Code einfach auskommentieren kann ich natürlich, aber ich will ja mehr.  Frage also:

Wäre es sehr aufwändig, in der Messagebox eine Schaltfläche zu installieren, mit der der Arbeitspunkt nur dann gesetzt wird, wenn man das wirklich möchte?

------------------
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

---

Das ist nicht besonders schwierig. Folgend mein Vorschlag

Code:

---

Public Sub WorkPointAtMassCenter()
    ' Check to make sure a part document is active.
    'If ThisApplication.ActiveDocumentType <> kPartDocumentObject Then
    '    MsgBox "A part document must be active."
    '    Exit Sub
    'End If

    ' Set a reference to the active document.
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument

    ' Get the Center of Mass.
    Dim oCenterOfMass As Point
    Set oCenterOfMass = oDoc.ComponentDefinition.MassProperties.CenterOfMass
   
    Dim sX As String
    Dim sY As String
    Dim sZ As String
   
    sX = CStr(Round(oCenterOfMass.X, 2))
    sY = CStr(Round(oCenterOfMass.Y, 2))
    sZ = CStr(Round(oCenterOfMass.Z, 2))
   
    Dim r As VbMsgBoxResult
    r = MsgBox("Schwerpunktkoordinaten:" & sX & ", " & sY & ", " & sZ & vbCrLf _
            & "Arbeitspunkt erstellen?", vbYesNoCancel, "Titel")
    If Not vbYes = r Then Exit Sub
    'nur bei "JA" gehts unten weiter
    ' evtl. sollte man das noch umbauen, dass bei einem Nein der Punkt gelöscht wird (ist ja sonst nicht aktuell)
    '  oder umbenennen in ...outdated ?

    ' Check to see if a work point for center of mass already exists.
    ' This uses the name of the work feature to identify it.
    On Error Resume Next
    Dim oWorkPoint As WorkPoint
    Set oWorkPoint = oDoc.ComponentDefinition.WorkPoints.Item("Center Of Mass")
    If Err.Number = 0 Then
        On Error GoTo 0    'KraBBy: Fehler werden wieder gemeldet und nicht einfach übergangen
        Dim oFixedDef As AssemblyWorkPointDef    'KraBBy: war FixedWorkPointDef    -> vorher wurde der Punkt nie aktualisiert
        Set oFixedDef = oWorkPoint.Definition

        oFixedDef.Point = oCenterOfMass
        oDoc.Update
    Else
        ' Create a new workpoint at the location of the center of mass.
        Set oWorkPoint = oDoc.ComponentDefinition.WorkPoints.AddFixed(oCenterOfMass)

        ' Rename the work point.
        oWorkPoint.Name = "Center Of Mass"
    End If
End Sub

---

------------------
Gruß KraBBy

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

---

Zitat:

---

Original erstellt von Roland Schröder:
[...] da der erzeugte Arbeitspunkt sich nicht automatisch aktualisiert [...]

---

Da könnte man auch ansetzen, wenn gewünscht: Man könnte das über eine iLogic-Regel und einen Ereignisauslöser automatisieren. In der Regel nur eine Zeile Code, die das bestehende VBA-Makro (dann besser ohne MsgBox) aufruft. Als Ereignis evtl. "vor dem Speichern" oder auch "beliebige Modellparameteränderung", je nach Wunsch oder auch Dauer der Berechnung.

------------------
Gruß KraBBy

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

---

[Edit: Post war doppelt]

[Diese Nachricht wurde von KraBBy am 23. Jun. 2023 editiert.]

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