Hier der Text des VBA Makros. Ab Zeile 29 (ohne Zeilennummern) fehlt mir der Ansatz, den username für die Veröffentlichungen der einzelnen Elemente zu verwenden. Danke für die schnelle Frage. Dieter
Sub CATMain()
1 version = "1.0"
2 makroname = "Achsensystem veröffentlichen"
3 On Error Resume Next
4 Set activedoc = CATIA.ActiveDocument
5 If Err.Number <> 0 Then
6 MsgBox "Es ist kein Bauteil (CATPart) geöffnet", 16, makroname + " " + version
7 Exit Sub
8 End If
'Auslesen der Dokumentart ------
9 If (Right(activedoc.Name, 7) <> "CATPart") Then 'Part
10 MsgBox "Aktives Dokument ist kein Bauteil", 16, makroname + " " + version
11 Exit Sub
12 End If
'~~~ Meldung an den Anwendern bezüglich der Anwendung ~~~~
'Zeilenumbruch durch '& Chr(13)'
'MsgBox "Hier stehen kurz die ersten Schritte für die korrekte Anwendung"
'~~~ Meldung-Ende ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'### Haupteil des Makros #################################
'V5 wird direkt durch 'CATIA' angesprochen
'z.B. CATIA.ActiveDocument
'- - - - - - - - - - - - - - -
13 Set selection1 = activedoc.Selection
Dim InputObjectType(0)
14 InputObjectType(0) = "AnyObject"
15 Status = selection1.SelectElement2(InputObjectType, "Wählen Sie das zu veröffentliche Achsensystem aus", True)
16 If (Status = "Cancel") Then
17 MsgBox "Makro wurde abgebrochen", 16, makroname & " " & version
18 Exit Sub
19 Else
20 Set usersel = selection1.Item(1).Value
Dim seltype
21 seltype = TypeName(usersel)
22 selection1.Clear
23 UserName = InputBox("Geben Sie den neuen Namen ein", makroname & " " & version, usersel.Name)
24 If (UserName = "") Then
25 MsgBox "Makro wurde abgebrochen", 16, makroname & " " & version
26 Exit Sub
27 Else
28 If seltype <> "Part" Then
29 usersel.Name = UserName
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim product1 As Product
Set product1 = partDocument1.GetItem("Part1")
'Dim reference1 As Reference
'Set reference1 = product1.CreateReferenceFromName("Part1/!Axis System.3")
'Set reference1 = product1.CreateReferenceFromName(usersel.Name)
MsgBox "Makro = "
'Dim publications1 As Publications
'Set publications1 = product1.Publications
Dim publication1 As Publication
'Set publication1 = publications1.Add("Axis System.3")
Set publication1 = publications1.Add(usersel.Name)
'publications1.SetDirect "Axis System.3", reference1
publications1.SetDirect usersel.Name, reference1
Dim reference2 As Reference
Set reference2 = product1.CreateReferenceFromName("Part1/!Selection_FVertex Vertex Neighbours Face Brp AxisSystem.3;2);None );Cf11 ));Face Brp AxisSystem.3;3);None );Cf11 ));Face Brp A xisSystem.3;1);None );Cf11 )));Cf11 ));AxisSystem.3;InSameTool;Z0;G3491)")
Dim publication2 As Publication
Set publication2 = publications1.Add("Origin1")
publications1.SetDirect "Origin1", reference2
Dim reference3 As Reference
Set reference3 = product1.CreateReferenceFromName("Part1/!Selection_REdge Edge Face Brp AxisSystem.3;1);None );Cf11 ));Face Brp AxisSystem.3;3);None );Cf11 ));None Limits1 );Limits2 )) ;Cf11 ));AxisSystem.3;InSameTool;Z0;G3491)")
Dim publication3 As Publication
Set publication3 = publications1.Add("X Axis1")
publications1.SetDirect "X Axis1", reference3
Dim reference4 As Reference
Set reference4 = product1.CreateReferenceFromName("Part1/!Selection_REdge Edge Face Brp AxisSystem.3;2);None );Cf11 ));Face Brp AxisSystem.3;1);None );Cf11 ));None Limits1 );Limits2 )) ;Cf11 ));AxisSystem.3;InSameTool;Z0;G3491)")
Dim publication4 As Publication
Set publication4 = publications1.Add("Y Axis1")
publications1.SetDirect "Y Axis1", reference4
Dim reference5 As Reference
Set reference5 = product1.CreateReferenceFromName("Part1/!Selection_REdge Edge Face Brp AxisSystem.3;3);None );Cf11 ));Face Brp AxisSystem.3;2);None );Cf11 ));None Limits1 );Limits2 )) ;Cf11 ));AxisSystem.3;InSameTool;Z0;G3491)")
Dim publication5 As Publication
Set publication5 = publications1.Add("Z Axis1")
publications1.SetDirect "Z Axis1", reference5
Dim reference6 As Reference
Set reference6 = product1.CreateReferenceFromName("Part1/!Selection_RSur Face Brp AxisSystem.3;1);None );Cf11 ));AxisSystem.3;InSameTool;Z0;G3491)")
Dim publication6 As Publication
Set publication6 = publications1.Add("XY Plane1")
publications1.SetDirect "XY Plane1", reference6
Dim reference7 As Reference
Set reference7 = product1.CreateReferenceFromName("Part1/!Selection_RSur Face Brp AxisSystem.3;2);None );Cf11 ));AxisSystem.3;InSameTool;Z0;G3491)")
Dim publication7 As Publication
Set publication7 = publications1.Add("YZ Plane1")
publications1.SetDirect "YZ Plane1", reference7
Dim reference8 As Reference
Set reference8 = product1.CreateReferenceFromName("Part1/!Selection_RSur Face Brp AxisSystem.3;3);None );Cf11 ));AxisSystem.3;InSameTool;Z0;G3491)")
Dim publication8 As Publication
Set publication8 = publications1.Add("ZX Plane1")
publications1.SetDirect "ZX Plane1", reference8
Dim settingControllers1 As SettingControllers
Set settingControllers1 = CATIA.SettingControllers
Dim visualizationSettingAtt1 As VisualizationSettingAtt
Set visualizationSettingAtt1 = settingControllers1.Item("CATVizVisualizationSettingCtrl")
visualizationSettingAtt1.SaveRepository
30 Else
31 usersel.Parent.Product.PartNumber = UserName
32 End If
33 End If
34 End If
'### Haupteil-Ende ######################################
'+++ Ausgabe der Fehler ++++++++++++++++++++++++++++
35 iErr = Err.Number
36 If (iErr <> 0) Then
37 MsgBox (Err.Description)
38 Exit Sub
39 End If
'+++ Fehler-Ende ++++++++++++++++++++++++++++++++++
'--- Abschlussmeldung an Anwender --------------------------
'MsgBox "Makro ist beendet", 64, "Rename"
'------------------------------------------------------------------------------
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP