Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
Anonymous
546 Views, 1 Reply

Constrain all components in assembly

Hello,
I found the following code in a forum.
What I need is a code, that constrains all components in an assembly without selecting them.
"For each..." But my programming skills are only basics. And I cant get it to work.
Anyone have a code or can edit the existing one?

I need constrains. I found grounding of components already. But sometimes I need to move a part or subassembly a bit away from ground. With constrains it is easyer for me.

Public Sub bewegeKomponenteZumUrsprung()
Dim oDoc As Document
Dim oAsmCompDef As AssemblyComponentDefinition
Dim oAsmWorkPlane(1 To 3) As WorkPlane
Dim oOcc2 As ComponentOccurrence
Dim oPartPlane2 As WorkPlane
Dim oAsmPlane2 As WorkPlaneProxy
Dim oSelectSet As SelectSet
Dim i As Long
 
  Set oDoc = ThisApplication.ActiveDocument
  If oDoc.DocumentType <> kAssemblyDocumentObject Then
    MsgBox "Dieses Makro funktioniert nur in einer Baugruppe! Dieses Makro fixiert eine Bauteil/Baugruppe im Ursprung der aktuellen Baugruppe.", vbCritical
    Exit Sub
  End If
 
  Set oSelectSet = ThisApplication.ActiveDocument.SelectSet
   
  ' Validate the correct data is in the select set.
  If oSelectSet.Count <> 1 Then
    MsgBox "Es darf nur ein einzelnes Element ausgewählt sein!", vbCritical
    Exit Sub
  End If
 
  'Debug.Print oSelectSet.Item(1).Type
  If oSelectSet.Item(1).Type = 67113776 Then
    ' Die Nummer ist "hart verdrahtet", weil ich sonst keine andere Möglichkeit/Konstante gefunden habe.
    Set oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition
    Set oOcc2 = oAsmCompDef.Occurrences.ItemByName(oSelectSet.Item(1).Name)
 
    For i = 1 To 3
      ' Arbeitsebenen der Baugruppe auslesen
      Set oAsmWorkPlane(i) = ThisApplication.ActiveDocument.ComponentDefinition.WorkPlanes.Item(i)
      'Arbeitsebene des Bauteils/Baugruppe auslesen
      Set oPartPlane2 = oOcc2.Definition.WorkPlanes.Item(i)
      ' Proxy Berechnung (Bauteil-Koords -> Baugruppen-Koords)
      Call oOcc2.CreateGeometryProxy(oPartPlane2, oAsmPlane2)
      ' fluchtende Abhängigkeit vergeben
      Call oAsmCompDef.Constraints.AddFlushConstraint(oAsmWorkPlane(i), oAsmPlane2, 0)
    Next i
  Else
    MsgBox "Es muß ein Bauteil oder eine Baugruppe ausgewählt sein!", vbCritical
  End If
End Sub

http://ww3.cad.de/foren/ubb/Forum258/HTML/000379.shtml