Hallo zusammen!
ich habe folgendes Problem. In einem Product sind weitere Producte enthalten. Diese enthalten wiederrum einzelne Parts. Ein Part beinhaltet maßgebende Sketche. Diese Sketch besitzen Ausgaben die veröffentlicht werden sollen. Hierzu habe ich ein Script geschrieben welches den User auffordert, das entsprechende Part (welches die Ausgaben enthält) ersteinmal zu selektieren und dann die zu veröffentlichenden Ausgaben zu selektieren. Dies klappt so weit ganz gut.
Am Ende des Durchlaufs werden jedoch die Veröffentlichungen unter das Product gehangen und nicht unter das selektierte Part. Dadurch lassen sich die Veröffentlichungen nicht mehr anwählen. Finde leider meinen Fehler nicht.
Vielleicht kann mir ja jemand weiter helfen. In der Abbildung ist ein einfaches Beispiel der Produktstruktur gezeigt mit der falschen Ebene der Veröffentlichung.
Mein Script sieht wie folgt aus:
Sub CATMain()
Dim ProductTest As CATBaseDispatch
Dim MyDocument As Document
Set MyDocument = CATIA.ActiveDocument
Dim CRSSelection As Object
Set CRSSelection = MyDocument.Selection
If TypeName(CATIA.ActiveDocument) = "ProductDocument" Then
MsgBox "Bitte das PartDocument in der die Veröffentlichung erzeugt werden soll, selektieren"
Dim DocuTyp(0)
DocuTyp(0) = "Part"
AuswahlDocuTyp = CRSSelection.SelectElement2(DocuTyp, "Bitte Part selektieren, 'Esc' zum Abbrechen", True)
If AuswalDocuTyp = "Cancel" Then Exit Sub
Set CRSPart = CRSSelection.Item(1).Value
ElseIf TypeName(CATIA.ActiveDocument) = "PartDocument" Then
Set CRSPart = CATIA.ActiveDocument.Part
Else
MsgBox "Das geöffnete Dokument ist kein Part und das Makro wir beendet"
Exit Sub
End If
Dim CRSName As String
CRSName = CRSPart.Name
CATIA.StartWorkbench ("PrtCfg")
CRSSelection.Clear
Set ProductTest = MyDocument.GetItem(CRSName)
Dim VerSelection As AnyObject
Set VerSelection = MyDocument.Selection
Dim Part As Product
Set Part = MyDocument.Product
Dim Arbeitsteil As Products
Set Arbeitsteil = Part.Products
MsgBox "zu veröffentlichende Objekte markieren! (Mehrfachauswahl mit gedrückter STRG-Taste)"
Dim VerElement(1)
VerElement(0) = "AnyObject"
VerElement(1) = "AnyObject"
Dim VerName As String
Dim Status As String
Dim VerObject As Object
Dim AusgabeName As String
Status = VerSelection.SelectElement3(VerElement, "Bitte die Elemente selektieren", False, CATMultiSelTriggWhenUserValidatesSelection, False)
If (Status = "Cancel") Then
MsgBox "Makro wird beendet"
Exit Sub
ElseIf Status = "Normal" Then
For z = 1 To VerSelection.Count
Set VerObject = VerSelection.Item2(z).Value.GetItem("ModelElement")
VerName = VerObject.InternalName
Nameintern = VBA.Left(VerName, VBA.InStr(1, VerName, ".") - 1)
ProfilName = Len(Nameintern)
If (ProfilName = 7) Then
AusgabeName = CStr(Mid(VerName, 1, 6) & Mid(VerName, 8)) '1,7 für Englische Versionen da Profil vs. Profile
MsgBox ("der interne Name lautet: - " & AusgabeName)
Else
MsgBox "Englische Version"
End If
Dim VerProduct As AnyObject
Dim VerReference As Reference
Dim publications1 As Publications
Dim publication1 As Publication
Set VerProduct = MyDocument.Product
Set VerReference = ProductTest.CreateReferenceFromName(CRSName & "/!" & AusgabeName)
Set publications1 = VerProduct.Publications
Set publication1 = publications1.Add(AusgabeName)
publications1.SetDirect AusgabeName, VerReference
Next
End If
End Sub
Grüße
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP