VBA-Makro: Alle ausgewählten Komponenten auf den Ursprung legen
Igor hat mir ein Makro gemailt, das alle ausgewählten Komponenten einer Baugruppe auf den Baugruppenursprung schiebt.
Sub GoToOrigin()
If ThisApplication.Documents.Count = 0 Then
MsgBox "Keine Dokumente geöffnet"
Exit Sub
End If
If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject Then
MsgBox "Das geöffnete Dokument ist keine Baugruppe"
Exit Sub
End If
Dim oAsm As AssemblyDocument
Set oAsm = ThisApplication.ActiveDocument
If oAsm.SelectSet.Count = 0 Then
MsgBox "Es sind keine Komponenten selektiert"
Exit Sub
End If
Dim oOcc As ComponentOccurrence
Dim oTransformation As Matrix
Dim oMatrix As Matrix
Set oMatrix = ThisApplication.TransientGeometry.CreateMatrix
Dim dCells(15) As Double
Call oMatrix.GetMatrixData(dCells)
For Each oOcc In oAsm.SelectSet
Call oMatrix.PutMatrixData(dCells)
oOcc.Transformation = oMatrix
Next
End Sub
Autor: Igor Zupevc aka daywa1k3r [FX64 Software Solutions] – Danke Igor!



