---

Moin Moin,

ich habe mal diverse Codefetzen zusammengesucht und mir daraus ein nettes, kleines Tool gebastelt. Es soll angewählte Teile in einer Assembly in 0,0,0 verschieben, fixieren und in Null-Lage drehen.

Verschieben und fixieren klappt. Bestehende Abhängigkeiten werden sogar unterdrückt. Nur das Drehen klappt nicht.

Achtung: Ich nix großer VB Profi!! Ich kenne Alt+F11 ... 

Hier mein Werk bis jetzt:

Code:

---

Public Sub MoveFix()
    ' Set a reference to the assembly component definintion.
    Dim oAsmCompDef As AssemblyComponentDefinition
    Set oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition
   
    ' Get an occurrence from the select set.
    On Error Resume Next
    Dim oOccurrence As ComponentOccurrence
    Set oOccurrence = ThisApplication.ActiveDocument.SelectSet.Item(1)
    If Err Then
        MsgBox "An occurrence must be selected."
        Exit Sub
    End If
    On Error GoTo 0
   
    ' Get the current transformation matrix from the occurrence.
    Dim oTransform As Matrix
    Set oTransform = oOccurrence.Transformation
   
    ' Suppress the existing constraints.
    Dim oConstraint As AssemblyConstraint
    For Each oConstraint In oOccurrence.Constraints
    oConstraint.Suppressed = True
    Next
       
    ' Move the occurrence ignoring any constraints.
    ' Anything that causes the assembly to recompute will cause the
    ' occurrence to reposition itself to honor the constraints.
    oTransform.SetTranslation ThisApplication.TransientGeometry.CreateVector(0, 0, 0)
    Call oOccurrence.SetTransformWithoutConstraints(oTransform)
 
    ' Turn the component to zero position
    Dim oMatrix As Matrix
    Dim ovec As Vector
    Dim otg As TransientGeometry
    Set otg = ThisApplication.TransientGeometry
    Set ovec = otg.CreateVector(0, 0, 0)
    Set oMatrix = ThisApplication.TransientGeometry.CreateMatrix
    Call oMatrix.SetToRotation(3.14159265358979 / 4, ovec, ThisApplication.TransientGeometry.CreatePoint(0, 0, 0))
 
    ' Iterate through all of the occurrences and ground them.
        oOccurrence.Grounded = True
    'Next

End Sub

---

Wer kann helfen?!?

------------------
Gruß
Kay
____
Wenn sich die Gelegenheit zu einem Fehler ergibt, wird er gemacht. Der Zeitpunkt ist immer maximal ungeeignet. 

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

---

Wo auch immer du den Quellcode kopiert hast   hast du das vergessen:

Code:

---

    Dim oOccMatrix As Matrix
    Set oOccMatrix = oOccurrence.Transformation

    Call oOccMatrix.MultiplyBy(oMatrix)
    oOccurrence.Transformation = oOccMatrix

---

Und als Vector würde ich je nach Achse  

das:
Set ovec = otg.CreateVector(1, 0, 0)

das:
Set ovec = otg.CreateVector(0, 1, 0)

oder das
Set ovec = otg.CreateVector(0, 0, 1)

nehmen.

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

FX64 Software Solutions

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

---

Zitat:

---

Original erstellt von daywa1k3r:
Wo auch immer du den Quellcode kopiert hast    hast du das vergessen:

---

och, wenn man in der VBA-Hilfe surft, gibts da ein paar ganz schmucke Samples,... 

Aber vielen Dank, werd ich gleich mal ausprobieren!

------------------
Gruß
Kay
____
Wenn sich die Gelegenheit zu einem Fehler ergibt, wird er gemacht. Der Zeitpunkt ist immer maximal ungeeignet. 

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

---

Hi, Allerseits!
Ehe ich jetzt auf den Threat verweise oder alles nochmal aufschreib, wärme ich ihn einfach mal wieder auf.

Ich möchte auch ein Bauteil drehen - geht auch wie oben beschrieben - allerdings soll dies aber um SEINEN eigenen Mittelpunkt drehen. Die o.g. Routine verschiebt das Bauteil aber immer in den Zeichungsursprung und dreht es dort.

Nun habe ich die BT-Koordinaten über die Transient Funktion ausgelesen und den Punkt um den gedreht werden soll somit nicht in 0,0,0 sondern in den aktuellen Koordinaten des Bauteiles festgelegt.

Leider schiebt IV das Teil immer noch nach 0,0,0 - was mache ich falsch?

VG Tom

------------------
Einfach mal rechts fahren....

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