Hallo Leute,
habe im Kochbuch vom Ansatz her ein brauchbares Makro kann es so aber nicht so in der Praxis einsetzen.
In dem Makro sollen die Rohmasse ermittelt werden, dazu wird hier ein Achsensystem auf einen Schwerpunkt erzeugt.
Ich möchte aber ein bereits bestehendes Achsensystem selektieren und dessen Richtungen weiterverwenden.
Ich gehe davon aus das nicht jeder das Buch hat, deswegen stelle ich es zur Ansicht rein.
Makro ist CATVBA
Ich arbeite mit CATIA V5 R19
Ich hoffe es kann mir jemand weiterhelfen.
Kochbuchmakro (Rezept 17):
Dim version, makroname
Sub CATMain()
1 version = "1.0"
2 makroname = "Rohteil-Abmessung"
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
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)'
13 MsgBox "Wählen Sie den zu untersuchenden Körper aus", vbInformation, makroname + " " + version
'~~~ Meldung-Ende ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'### Haupteil des Makros #################################
'V5 wird direkt durch 'CATIA' angesprochen
'z.B. CATIA.ActiveDocument
'- - - - - - - - - - - - - - -
14 Set selection1 = activedoc.Selection
Dim InputObjectType(0)
15 InputObjectType(0) = "Body"
16 Status = selection1.SelectElement2(InputObjectType, "Wählen Sie den Körper aus", False)
17 If (Status = "Cancel") Then
18 MsgBox "Makro wurde abgebrochen", 16, makroname + " " + version
19 Exit Sub
20 Else
21 Set usersel = selection1.Item(1).Value
22 Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
23 Set Inertia1 = TheSPAWorkbench.Inertias.Add(usersel)
Dim Components1(8)
24 Inertia1.GetPrincipalAxes Components1
25 Set part1 = activedoc.Part
'Schwerpunkt
26 Set reference1 = part1.CreateReferenceFromObject(usersel)
27 Set Measurable1 = TheSPAWorkbench.GetMeasurable(reference1)
Dim Gcoord(2)
28 Measurable1.GetCOG Gcoord
29 Set hybridBodies1 = part1.HybridBodies
30 Set hybridBody1 = hybridBodies1.Add
31 hybridBody1.Name = "Extremum_" + usersel.Name
32 Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim directions1(2)
33 Set directions1(0) = hybridShapeFactory1.AddNewDirectionByCoord(Components1(0), Components1(3), Components1(6))
34 Set directions1(1) = hybridShapeFactory1.AddNewDirectionByCoord(Components1(1), Components1(4), Components1(7))
35 Set directions1(2) = hybridShapeFactory1.AddNewDirectionByCoord(Components1(2), Components1(5), Components1(8))
'Neues Achsensystem im Schwerpunt
36 Set AxisSystem1 = part1.AxisSystems.Add()
37 AxisSystem1.PutOrigin Gcoord
Dim vectorXCoord(2)
38 vectorXCoord(0) = Components1(0)
39 vectorXCoord(1) = Components1(3)
40 vectorXCoord(2) = Components1(6)
Dim vectorYCoord(2)
41 vectorYCoord(0) = Components1(1)
42 vectorYCoord(1) = Components1(4)
43 vectorYCoord(2) = Components1(7)
44 AxisSystem1.PutVectors vectorXCoord, vectorYCoord
'axisSystem1.IsCurrent = 1
45 Set reference1 = part1.CreateReferenceFromObject(usersel)
46 selection1.Clear
47 For i = 0 To 2
48 Set ertremum1_max = hybridShapeFactory1.AddNewExtremum(reference1, directions1(i), 1)
49 hybridBody1.AppendHybridShape ertremum1_max
50 Set ertremum1_min = hybridShapeFactory1.AddNewExtremum(reference1, directions1(i), 0)
51 hybridBody1.AppendHybridShape ertremum1_min
52 Next
53 part1.Update
Dim distances1(8)
Dim roughpart(2)
54 For i = 0 To 2
55 Set reference1 = part1.CreateReferenceFromObject(hybridBody1.HybridShapes.Item((i * 2) + 1))
56 Set reference2 = part1.CreateReferenceFromObject(hybridBody1.HybridShapes.Item((i * 2) + 2))
57 Set Measurable1 = TheSPAWorkbench.GetMeasurable(reference1)
58 Measurable1.GetMinimumDistancePoints reference2, distances1
59 Set point1 = hybridShapeFactory1.AddNewPointOnCurveFromPercent(reference1, 0.5, False)
60 hybridBody1.AppendHybridShape point1
61 part1.Update
62 If Err.Number <> 0 Then
63 selection1.Add point1
64 selection1.Delete
65 Set point1 = hybridShapeFactory1.AddNewPointCoord(distances1(0), distances1(1), distances1(2))
66 Err.Clear
67 End If
68 Set reference3 = part1.CreateReferenceFromObject(point1)
69 Set point2 = hybridShapeFactory1.AddNewPointOnCurveFromPercent(reference2, 0.5, False)
70 hybridBody1.AppendHybridShape point2
71 part1.Update
72 If Err.Number <> 0 Then
73 selection1.Add point2
74 selection1.Delete
75 Set point2 = hybridShapeFactory1.AddNewPointCoord(distances1(3), distances1(4), distances1(5))
76 Err.Clear
77 End If
78 Set reference4 = part1.CreateReferenceFromObject(point2)
79 Select Case i
Case 0
80 Set reference0 = part1.CreateReferenceFromBRepName("RSur Face Brp " & part1.AxisSystems.Item(part1.AxisSystems.Count).Name & ";2);None );Cf11 ));WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", AxisSystem1)
81 Case 1
82 Set reference0 = part1.CreateReferenceFromBRepName("RSur Face Brp " & part1.AxisSystems.Item(part1.AxisSystems.Count).Name & ";3);None );Cf11 ));WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", AxisSystem1)
83 Case 2
84 Set reference0 = part1.CreateReferenceFromBRepName("RSur Face Brp " & part1.AxisSystems.Item(part1.AxisSystems.Count).Name & ";1);None );Cf11 ));WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", AxisSystem1)
85 End Select
86 Set hybridShapePlaneOffsetPt1 = hybridShapeFactory1.AddNewPlaneOffsetPt(reference0, reference3)
87 hybridBody1.AppendHybridShape hybridShapePlaneOffsetPt1
88 Set hybridShapePlaneOffsetPt2 = hybridShapeFactory1.AddNewPlaneOffsetPt(reference0, reference4)
89 hybridBody1.AppendHybridShape hybridShapePlaneOffsetPt2
90 part1.Update
91 Set reference5 = part1.CreateReferenceFromObject(hybridShapePlaneOffsetPt1)
92 Set reference6 = part1.CreateReferenceFromObject(hybridShapePlaneOffsetPt2)
93 Set Measurable1 = TheSPAWorkbench.GetMeasurable(reference5)
94 roughpart(i) = Measurable1.GetMinimumDistance(reference6)
95 Next
96 selection1.Add hybridBody1
97 selection1.Add AxisSystem1
98 selection1.Delete
Dim wert1, wert2, wert3
99 wert1 = roughpart(0)
100 wert2 = roughpart(1)
101 wert3 = roughpart(2)
102 MsgBox "Die Rohteilabmessungen lauten:" & Chr(13) & "Richtung1 = " & CInt(wert1) & "mm" & Chr(13) & "Richtung2 = " & CInt(wert2) & "mm" & Chr(13) & "Richtung3 = " & CInt(wert3) & "mm" & Chr(13), vbInformation, makroname + " " + version
103 End If
'### Haupteil-Ende ######################################
'+++ Ausgabe der Fehler ++++++++++++++++++++++++++++
104 iErr = Err.Number
105 If (iErr <> 0) Then
106 MsgBox (Err.Description)
107 Exit Sub
108 End If
'+++ Fehler-Ende ++++++++++++++++++++++++++++++++++
End Sub
------------------
Mit freundlichem Gruß
Andreas
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP