bitteschön:
Public oSelection
Sub CATMain()
'On Error Resume Next
Dim oProduct
Dim oProducts
Dim bIsAComponent As Boolean
Set oRoot = CATIA.ActiveDocument
Set oProduct = oRoot.Product
Set oProducts = oProduct.Products
Set oSelection = CATIA.ActiveDocument.Selection
SUB_ProdScan oProducts, False
End Sub
Sub SUB_ProdScan(oProducts, bIsAComponent) 'Rekursive Funktion: Scant alle Subs
On Error Resume Next
If bIsAComponent = False Then
Set oConnections = CATIA.Documents.Item(oProducts.Parent.ReferenceProduct.Parent.Name).Product.Connections("CATIAConstraints")
ElseIf bIsAComponent = True Then
Set oConnections = oProducts.Parent.Connections("CATIAConstraints")
End If
iConnectionsCount = oConnections.Count
oSelection.Clear
conKO = 0
For A = 1 To iConnectionsCount
oSelection.Add (oConnections.Item(A))
Set MyConstrain = oConnections.Item(A)
If MyConstrain.Status = catCstStatusOK Then
' MsgBox "Der Constraint " & MyConstrain.Name & " ist i.O."
Else
conKO = conKO + 1
End If
Next
If conKO > 0 Then
Eingabe = MsgBox("Ein Constraint des Produktes " & vbCrLf & oProducts.Parent.Name & vbCrLf & "ist nicht up to date." _
& vbCrLf & vbCrLf & "==> Alle Constraints aktualisieren und weitermachen?", vbYesNo)
'MsgBox (oProducts.Parent.Name)
If Eingabe = vbNo Then
MsgBox "dann halt nicht"
Else
MsgBox "Produkt update könnte ich jetzt gemacht haben"
End If
Else
End If
If oSelection.Count > 0 Then
'oSelection.Clear
'oSelection.Delete
End If
oSelection.Clear
For X = 1 To oProducts.Count 'zaehlt die Children des aktuellen Subs
If bIsAComponent = False Then 'übergebenes Root ist keine Komponente
Set oProductOpen = CATIA.Documents.Item(oProducts.Parent.PartNumber & ".CATProduct").Product
'-----------Fixieren
Set oReference = oProductOpen.CreateReferenceFromName(oProductOpen.PartNumber & "/" & oProductOpen.Products.Item(X).Name & "/!" & oProductOpen.PartNumber & "/" & oProductOpen.Products.Item(X).Name & "/")
'Set oConstraint = oProductOpen.Connections("CATIAConstraints").AddMonoEltCst(catCstTypeReference, oReference)
ElseIf bIsAComponent = True Then 'übergebenes Root ist eine Komponente
Set oReference = oProducts.Parent.CreateReferenceFromName(oProducts.Parent.PartNumber & "/" & oProducts.Parent.Products.Item(X).Name & "/!" & oProducts.Parent.PartNumber & "/" & oProducts.Parent.Products.Item(X).Name & "/")
'Set oConstraint = oProducts.Parent.Connections("CATIAConstraints").AddMonoEltCst(catCstTypeReference, oReference)
End If
If TypeName(oProducts.Item(X).ReferenceProduct.Parent) = "PartDocument" Then 'Check ob PartDoc
' passiert gar nix
ElseIf TypeName(oProducts.Item(X).ReferenceProduct.Parent) = "ProductDocument" Then
Err.Number = 0
Set oMasterShape = oProducts.Item(X).GetMasterShapeRepresentation(True)
If Err.Number = 0 Then 'it s a others
' passiert gar nix
ElseIf oProducts.Item(X).ReferenceProduct.Parent.Name = oProducts.Item(X).Parent.Parent.ReferenceProduct.Parent.Name Then '---its a Component
Err.Number = 0
SUB_ProdScan CATIA.Documents.Item(oProducts.Item(X).ReferenceProduct.Parent.Name).GetItem(oProducts.Item(X).PartNumber).Products, True
ElseIf oProducts.Item(X).ReferenceProduct.Parent.Name <> oProducts.Item(X).Parent.Parent.ReferenceProduct.Parent.Name Then '---its a Product
Err.Number = 0
If oProducts.Item(X).Products.Count > 0 Then
Set oProductsUebergabe = oProducts.Item(X).Products
SUB_ProdScan oProductsUebergabe, False
End If
End If
Err.Number = 0
End If
Next
End Sub
Sub concheck(currentProduct)
MsgBox "Das ist der Produkt-Name: " & currentProduct.Name
Set my_constraints = currentProduct.Connections("CATIAConstraints")
MsgBox "Anzahl gefundener Constraints: " & my_constraints.Count
'UnUpdCstNum = my_constraints.UnUpdatedConstraintsCount
'MsgBox "Anzahl unupdated Constraints: " & UnUpdCstNum
For i = 1 To my_constraints.Count
Dim MyConstrain As Constraint
Set MyConstrain = my_constraints.Item(i)
If MyConstrain.Status = catCstStatusOK Then
MsgBox "Der Constraint " & MyConstrain.Name & " ist i.O."
Else
Eingabe = MsgBox("Ein Constraint des !Rootproduktes! ist nicht up to date. ==> Alle Constraints aktualisiern und weitermachen?", vbYesNo)
If Eingabe = vbNo Then
MsgBox "dann halt nicht"
Else
MsgBox "Produkt update könnte ich jetzt gemacht haben"
End If
End If
Next
End Sub
------------------
Frohes Schaffen
Michael Reiff
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP