---

Hallo

Ich habe Mal eine Bitte....
Ich habe solche extremkomplizierte (für mich) Makro gefunden:

Code:

---

'Copyright 2008 by Milton R. Hartung, Kamco Industries, Inc. (MiltonRH@kamcoind.com)
'Released under a creative commons Attribution-ShareAlike 3.0 license (http://creativecommons.org/licenses/by-sa/3.0/)
'
'code modified from bib or solid7 from http://2htts.com/CATBlog/index.php?itemid=24

'Creates a solid bounding box around a solid or surface, with the option to set offset on each face
'The document must be a CATPart
'Inputs:
'  - an Axis System
'  - A Face (Solid/Joined Surf will be chosen based on selection)
'----------------------------------------------------------------------------------------------------------------------------------

Sub CATMain()

    'Make sure they have axis ready and want to start
    CATIA.DisplayFileAlerts = False
    Dim Message, Style, Title, Response, MyString
    Message = ("This macro will create a solid bounding box around a solid or a joined surface, using an axis system.  For useful results," & _
        (Chr(13)) & _
        "the axis should be based on some tooling directions, or created from the Measure Inertia command (for best fit), not XYZ." & _
        (Chr(13)) & _
        "You will be prompted to select an Axis System and a Face belonging to the object you wish to bound." & _
        (Chr(13)) & _
        (Chr(13)) & _
        "  - The active document must be a CATPart" & _
        (Chr(13)) & _
        "  - The Axis System must be previously created" & _
        (Chr(13)) & _
        "" & (Chr(13)) & _
        "  Are you ready to continue?")
    Style = vbYesNo    'Define buttons.
   
    If MsgBox(Message, Style) = vbYes Then
        'Declare variables
        Dim axis
        Dim remake
        Dim partDocument1 As PartDocument
        Dim part1 As Part
        Dim axisref As Object
        Dim shapeFactory1 As ShapeFactory
        Dim hybridShapeFactory1 As HybridShapeFactory
        Dim sStatus As String
        Dim hybridShapeD1, hybridShapeD2, hybridShapeD3 As HybridShapeDirection
        Dim Default, a1, a2, a3, a4, a5, a6 'To change the offsets of the box
        Dim bodies1 As Bodies
        Dim body1 As Body
        Dim reference1 As Reference
        Dim HybridShapeExtremum1, HybridShapeExtremum2, HybridShapeExtremum3 As HybridShapeExtremum
        Dim HybridShapeExtremum4, HybridShapeExtremum5, HybridShapeExtremum6 As HybridShapeExtremum
        Dim originCoord(2)
        Dim selection As Object

        Set partDocument1 = CATIA.ActiveDocument
        If (InStr(partDocument1.Name, ".CATPart")) <> 0 Then
            Set part1 = partDocument1.Part
            Set selection = partDocument1.selection
            part1.Update
            Set hybridShapeFactory1 = part1.HybridShapeFactory
            ReDim sFilter(0)
            MsgBox "Select the axis to base the bounding on."
            sFilter(0) = "AxisSystem"
            sStatus = selection.SelectElement2(sFilter, "Select the axis to base the bounding on.", False)
            Dim axiscoord(2)
            Dim axissyst
            Set axissyst = selection.Item(1).Value
            Set axisref = selection.Item(1).Value
            ref_name_systaxis = axissyst.Name

            axissyst.IsCurrent = 1
            axissyst.Name = "BBoxAxis"

            axname = axissyst.Name
            Dim originpoint As HybridShapePointCoord
            axissyst.GetOrigin originCoord
            Set originpoint = hybridShapeFactory1.AddNewPointCoord(originCoord(0), originCoord(1), originCoord(2))
            Set axisref = part1.CreateReferenceFromObject(originpoint)
            axissyst.GetXAxis axiscoord
            Set hybridShapeD1 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))
            axissyst.GetYAxis axiscoord
            Set hybridShapeD2 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))
            axissyst.GetZAxis axiscoord
            Set hybridShapeD3 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))

            Dim Plane_line_1 As HybridShapeLinePtDir
            Set Plane_line_1 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD1, 0, 0, False)
            Dim Plane_line_2 As HybridShapeLinePtDir
            Set Plane_line_2 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD2, 0, 0, False)

            selection.Clear

            Set partDocument1 = CATIA.ActiveDocument
            Set part1 = partDocument1.Part
             
            Dim oBodies As Bodies
            Set oBodies = part1.Bodies

            'J is defined to make unique names for Axis and the Body for the bounding box
            Dim j As Integer
            j = oBodies.Count

            Set bodies1 = part1.Bodies
            Set body1 = bodies1.Add()
            body1.Name = "Bounding Box." & j
           
            Set hybridBodies1 = body1.HybridBodies
            Set hybridBody1 = hybridBodies1.Add
            hybridBody1.Name = "definition_points"

            ' Ask for face selection, that belongs to object to boundary
            ReDim sFilter(0)
            MsgBox "Select a face that belongs to the solid to be bounded."
            sFilter(0) = "Face"
            sStatus = selection.SelectElement2(sFilter, "Select a face that belongs to the solid to be bounded.", False)
            If (sStatus = "Cancel") Then
                Exit Sub
            End If

            Set reference1 = selection.Item(1).Value
            Dim hybridShapeExtract1 As HybridShapeExtract
            Set hybridShapeExtract1 = hybridShapeFactory1.AddNewExtract(reference1)
            hybridShapeExtract1.PropagationType = 1
            hybridShapeExtract1.ComplementaryExtract = False
            hybridShapeExtract1.IsFederated = False
            Set reference1 = hybridShapeExtract1

            'Create the 6 Extrenum items for the Solid/Surf.  May not be single points, will be solved with next points
            Set HybridShapeExtremum1 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD1, 1)
            Set HybridShapeExtremum2 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD1, 0)
            Set HybridShapeExtremum3 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD2, 1)
            Set HybridShapeExtremum4 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD2, 0)
            Set HybridShapeExtremum5 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD3, 1)
            Set HybridShapeExtremum6 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD3, 0)
            part1.Update
               
            ' Creates Geometrical Set under the Solid, to contain the construction elements

            Dim hybridBody2 As HybridBody
            Set hybridBody2 = hybridBodies1.Item("definition_points")

            hybridBody2.AppendHybridShape HybridShapeExtremum1
            part1.InWorkObject = HybridShapeExtremum1
            HybridShapeExtremum1.Name = "max_X"
            hybridBody2.AppendHybridShape HybridShapeExtremum2
            part1.InWorkObject = HybridShapeExtremum2
            HybridShapeExtremum2.Name = "min_X"
            hybridBody2.AppendHybridShape HybridShapeExtremum3
            part1.InWorkObject = HybridShapeExtremum3
            HybridShapeExtremum3.Name = "max_Y"
            hybridBody2.AppendHybridShape HybridShapeExtremum4
            part1.InWorkObject = HybridShapeExtremum4
            HybridShapeExtremum4.Name = "min_Y"
            hybridBody2.AppendHybridShape HybridShapeExtremum5
            part1.InWorkObject = HybridShapeExtremum5
            HybridShapeExtremum5.Name = "max_Z"
            hybridBody2.AppendHybridShape HybridShapeExtremum6
            part1.InWorkObject = HybridShapeExtremum6
            HybridShapeExtremum6.Name = "min_Z"

            part1.Update

            ' Creates a 6 single points using the Extrenums as refs, so if the Extrenum was a line or surf, you can still offset planes to these points

            Dim Ref1 As Reference
            Set Ref1 = part1.CreateReferenceFromObject(HybridShapeExtremum1)
            Dim Point1 As HybridShapePointCoord
            Set Point1 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref1)
            hybridBody2.AppendHybridShape Point1
            Set point_ref11 = part1.CreateReferenceFromObject(Point1)
            Dim Ref2 As Reference
            Set Ref2 = part1.CreateReferenceFromObject(HybridShapeExtremum2)
            Dim Point2 As HybridShapePointCoord
            Set Point2 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref2)
            hybridBody2.AppendHybridShape Point2
            Set point_ref12 = part1.CreateReferenceFromObject(Point2)
            Dim Ref3 As Reference
            Set Ref3 = part1.CreateReferenceFromObject(HybridShapeExtremum3)
            Dim Point3 As HybridShapePointCoord
            Set Point3 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref3)
            hybridBody2.AppendHybridShape Point3
            Set point_ref13 = part1.CreateReferenceFromObject(Point3)
            Dim Ref4 As Reference
            Set Ref4 = part1.CreateReferenceFromObject(HybridShapeExtremum4)
            Dim Point4 As HybridShapePointCoord
            Set Point4 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref4)
            hybridBody2.AppendHybridShape Point4
            Set point_ref14 = part1.CreateReferenceFromObject(Point4)
            Dim Ref5 As Reference
            Set Ref5 = part1.CreateReferenceFromObject(HybridShapeExtremum5)
            Dim Point5 As HybridShapePointCoord
            Set Point5 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref5)
            hybridBody2.AppendHybridShape Point5
            Set point_ref5 = part1.CreateReferenceFromObject(Point5)
            Dim Ref6 As Reference
            Set Ref6 = part1.CreateReferenceFromObject(HybridShapeExtremum6)
            Dim Point6 As HybridShapePointCoord
            Set Point6 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref6)
            hybridBody2.AppendHybridShape Point6
            Set point_ref6 = part1.CreateReferenceFromObject(Point6)

            part1.Update

            axissyst.IsCurrent = 1

            'Create a sketch, will the the X and Y boundary

            Set sketches1 = hybridBody1.HybridSketches
           
            Set reference_axis_syst = part1.CreateReferenceFromName("Selection_RSur:(Face:(Brp:(BBoxAxis;1);None:());BBoxAxis)")
           
            Set standard_body_sketch1 = sketches1.Add(reference_axis_syst)
            Set factory2D1 = standard_body_sketch1.OpenEdition()
            Set geometricElements1 = standard_body_sketch1.GeometricElements
            Set axis2D1 = geometricElements1.Item("AbsoluteAxis")
            Set line_HDirection = axis2D1.GetItem("HDirection")
            line_HDirection.ReportName = 1
            Set line_VDirection = axis2D1.GetItem("VDirection")
            line_VDirection.ReportName = 2
   
            ' Creates a square in the sketch
            ponto = 20000
            Set point_ref_1 = factory2D1.CreatePoint(-ponto, -ponto)
            point_ref_1.ReportName = 3
            Set point_ref_2 = factory2D1.CreatePoint(ponto, -ponto)
            point_ref_2.ReportName = 4
            Set point_ref_3 = factory2D1.CreatePoint(ponto, ponto)
            point_ref_3.ReportName = 5
            Set point_ref_4 = factory2D1.CreatePoint(-ponto, ponto)
            point_ref_4.ReportName = 6
           
            Set line_ref_1_2 = factory2D1.CreateLine(-ponto, -ponto, ponto, -ponto)
            line_ref_1_2.ReportName = 7
            line_ref_1_2.StartPoint = point_ref_1
            line_ref_1_2.EndPoint = point_ref_2
       
            Set line_ref_2_3 = factory2D1.CreateLine(ponto, -ponto, ponto, ponto)
            line_ref_2_3.ReportName = 8
            line_ref_2_3.StartPoint = point_ref_2
            line_ref_2_3.EndPoint = point_ref_3
           
            Set line_ref_3_4 = factory2D1.CreateLine(-ponto, ponto, ponto, ponto)
            line_ref_3_4.ReportName = 9
            line_ref_3_4.StartPoint = point_ref_4
            line_ref_3_4.EndPoint = point_ref_3
           
            Set line_ref_4_1 = factory2D1.CreateLine(-ponto, -ponto, -ponto, ponto)
            line_ref_4_1.ReportName = 10
            'line_ref_4_1.Construction = True
            line_ref_4_1.StartPoint = point_ref_1
            line_ref_4_1.EndPoint = point_ref_4
   
            ' Create Reference lines and constraints
            Set reference_line_ref_1_2 = part1.CreateReferenceFromObject(line_ref_1_2)
            Set reference_line_ref_2_3 = part1.CreateReferenceFromObject(line_ref_2_3)
            Set reference_line_ref_3_4 = part1.CreateReferenceFromObject(line_ref_3_4)
            Set reference_line_ref_4_1 = part1.CreateReferenceFromObject(line_ref_4_1)
           
            Set electrode_constraints = standard_body_sketch1.Constraints

            Set constraint_toto_2 = electrode_constraints.AddBiEltCst(catCstTypeDistance, point_ref11, reference_line_ref_2_3)
            Set constraint_toto_3 = electrode_constraints.AddBiEltCst(catCstTypeDistance, point_ref13, reference_line_ref_3_4)
            Set constraint_toto_4 = electrode_constraints.AddBiEltCst(catCstTypeDistance, reference_line_ref_4_1, point_ref12)
            Set constraint_toto_1 = electrode_constraints.AddBiEltCst(catCstTypeDistance, reference_line_ref_1_2, point_ref14)

            Dim length1 As Dimension
            Set length1 = constraint_toto_1.Dimension
            length1.Value = 0
            Dim length2 As Dimension
            Set length2 = constraint_toto_2.Dimension
            length2.Value = 0
            Dim length3 As Dimension
            Set length3 = constraint_toto_3.Dimension
            length3.Value = 0
            Dim length4 As Dimension
            Set length4 = constraint_toto_4.Dimension
            length4.Value = 0
           
            standard_body_sketch1.CloseEdition
            part1.Update

'----------------------------------------------------------------------------------------------------------------------------------
' Creation of the Max Z and Min Z planes
'----------------------------------------------------------------------------------------------------------------------------------

            Dim plan_inferieur As HybridShapePlaneOffsetPt
            Dim plan_origin As HybridShapePlane2Lines
            Dim Origin_line_1 As Reference
            Set Origin_line_1 = part1.CreateReferenceFromObject(line_HDirection)
            Dim Origin_line_2 As Reference
            Set Origin_line_2 = part1.CreateReferenceFromObject(line_VDirection)
            Set plan_origin = hybridShapeFactory1.AddNewPlane2Lines(Origin_line_1, Origin_line_2)
            Dim ref_plan_origin As Reference
            Set ref_plan_origin = part1.CreateReferenceFromObject(plan_origin)
            Set Ref6 = part1.CreateReferenceFromObject(HybridShapeExtremum6)
            Set plan_inferieur = hybridShapeFactory1.AddNewPlaneOffsetPt(ref_plan_origin, point_ref6)
            hybridBody2.AppendHybridShape plan_inferieur
            part1.InWorkObject = plan_inferieur

            Dim plan_superieur As HybridShapePlaneOffsetPt
            Set Ref5 = part1.CreateReferenceFromObject(HybridShapeExtremum5)
            Set plan_superieur = hybridShapeFactory1.AddNewPlaneOffsetPt(ref_plan_origin, point_ref5)
            hybridBody2.AppendHybridShape plan_superieur
            part1.InWorkObject = plan_superieur

            part1.Update
           
'----------------------------------------------------------------------------------------------------------------------------------
' Creates the line that sweeps around the XY Sketch boundary
'----------------------------------------------------------------------------------------------------------------------------------

            Dim Point_inf As HybridShapePointCoord
            Set Point_inf = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, point_ref6)
            hybridBody2.AppendHybridShape Point_inf
            Dim ref_point_inf As Reference
            Set ref_point_inf = part1.CreateReferenceFromObject(Point_inf)

            Dim proj_pt_inf As HybridShapeProject
            Set proj_pt_inf = hybridShapeFactory1.AddNewProject(point_ref6, plan_superieur)
            hybridBody2.AppendHybridShape proj_pt_inf
            part1.InWorkObject = proj_pt_inf

            Dim Point_sup As HybridShapePointCoord
            Set Point_sup = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, proj_pt_inf)
            hybridBody2.AppendHybridShape Point_sup
            Dim ref_point_sup As Reference
            Set ref_point_sup = part1.CreateReferenceFromObject(Point_sup)

            Dim line_guide As HybridShapeLinePtPt
            Set line_guide = hybridShapeFactory1.AddNewLinePtPt(ref_point_sup, ref_point_inf)
            hybridBody2.AppendHybridShape line_guide
            part1.InWorkObject = line_guide
            Set ref_guideline = part1.CreateReferenceFromObject(line_guide)

            Dim oStart As Length
            Set oStart = line_guide.BeginOffset
            oStart.Value = 1
            Dim oEnd As Length
            Set oEnd = line_guide.EndOffset
            oEnd.Value = 1

            Set constraints_for_z = part1.Constraints
            Set constraint_dz = constraints_for_z.AddMonoEltCst(catCstTypeLength, ref_guideline)
            Set length_dz = constraint_dz.Dimension
           
            part1.Update

'----------------------------------------------------------------------------------------------------------------------------------
' Second Sketch, basically the XY boundary sketch placed down to Min Z
'----------------------------------------------------------------------------------------------------------------------------------

            Set sketches2 = hybridBody1.HybridSketches
            Set standard_body_sketch2 = sketches2.Add(plan_inferieur)

            Set factory2D2 = standard_body_sketch2.OpenEdition()
            Set geometricElements2 = standard_body_sketch2.GeometricElements
            Set axis2D1 = geometricElements1.Item("AbsoluteAxis")

            pont = 200000
            Set point_ref1_1 = factory2D2.CreatePoint(-pont, -pont)
            Set point_ref1_2 = factory2D2.CreatePoint(pont, -pont)
            Set point_ref1_3 = factory2D2.CreatePoint(pont, pont)
            Set point_ref1_4 = factory2D2.CreatePoint(-pont, pont)
   
            Set line_ref1_1_2 = factory2D2.CreateLine(-pont, -pont, pont, -pont)
            line_ref1_1_2.StartPoint = point_ref1_1
            line_ref1_1_2.EndPoint = point_ref1_2
   
            Set line_ref1_2_3 = factory2D2.CreateLine(pont, -pont, pont, pont)
            line_ref1_2_3.StartPoint = point_ref1_2
            line_ref1_2_3.EndPoint = point_ref1_3
   
            Set line_ref1_3_4 = factory2D2.CreateLine(-pont, pont, pont, pont)
            line_ref1_3_4.StartPoint = point_ref1_4
            line_ref1_3_4.EndPoint = point_ref1_3
   
            Set line_ref1_4_1 = factory2D2.CreateLine(-pont, -pont, -pont, pont)
            line_ref1_4_1.StartPoint = point_ref1_1
            line_ref1_4_1.EndPoint = point_ref1_4

            Set reference_line_ref1_1_2 = part1.CreateReferenceFromObject(line_ref1_1_2)
            Set reference_line_ref1_2_3 = part1.CreateReferenceFromObject(line_ref1_2_3)
            Set reference_line_ref1_3_4 = part1.CreateReferenceFromObject(line_ref1_3_4)
            Set reference_line_ref1_4_1 = part1.CreateReferenceFromObject(line_ref1_4_1)

            Set reference_line_ref_1_2 = part1.CreateReferenceFromObject(line_ref_1_2)
            Set reference_line_ref_2_3 = part1.CreateReferenceFromObject(line_ref_2_3)
            Set reference_line_ref_3_4 = part1.CreateReferenceFromObject(line_ref_3_4)
            Set reference_line_ref_4_1 = part1.CreateReferenceFromObject(line_ref_4_1)

            Set proj_1_2 = factory2D2.CreateProjection(reference_line_ref_1_2)
            Set proj_2_3 = factory2D2.CreateProjection(reference_line_ref_2_3)
            Set proj_3_4 = factory2D2.CreateProjection(reference_line_ref_3_4)
            Set proj_4_1 = factory2D2.CreateProjection(reference_line_ref_4_1)

            Set ref_line_sk1_1_2 = part1.CreateReferenceFromObject(proj_1_2)
            Set ref_line_sk1_2_3 = part1.CreateReferenceFromObject(proj_2_3)
            Set ref_line_sk1_3_4 = part1.CreateReferenceFromObject(proj_3_4)
            Set ref_line_sk1_4_1 = part1.CreateReferenceFromObject(proj_4_1)
   
            Set electrode_constraints = standard_body_sketch2.Constraints
            Set constraint_toto_11 = electrode_constraints.AddBiEltCst(catCstTypeDistance, reference_line_ref1_1_2, ref_line_sk1_1_2)
            Set constraint_toto_12 = electrode_constraints.AddBiEltCst(catCstTypeDistance, ref_line_sk1_2_3, reference_line_ref1_2_3)
            Set constraint_toto_13 = electrode_constraints.AddBiEltCst(catCstTypeDistance, ref_line_sk1_3_4, reference_line_ref1_3_4)
            Set constraint_toto_14 = electrode_constraints.AddBiEltCst(catCstTypeDistance, reference_line_ref1_4_1, ref_line_sk1_4_1)
            'Dim length11 As Dimension
            Set length11 = constraint_toto_11.Dimension
            length11.Value = 1
            Dim length12 As Dimension
            Set length12 = constraint_toto_12.Dimension
            length12.Value = 1
            Dim length13 As Dimension
            Set length13 = constraint_toto_13.Dimension
            length13.Value = 1
            Dim length14 As Dimension
            Set length14 = constraint_toto_14.Dimension
            length14.Value = 1
           
            standard_body_sketch2.CloseEdition
            part1.Update
           
'----------------------------------------------------------------------------------------------------------------------------------
' Offset from Sketch2, using the Relations so you can change the offsets
'----------------------------------------------------------------------------------------------------------------------------------

            Set sketches3 = hybridBody1.HybridSketches
            Set standard_body_sketch3 = sketches3.Add(plan_inferieur)
            Set factory2D3 = standard_body_sketch3.OpenEdition()
            Set geometricElements3 = standard_body_sketch3.GeometricElements
            Set axis2D1 = geometricElements1.Item("AbsoluteAxis")

            Set reference_line_ref1_1_2 = part1.CreateReferenceFromObject(line_ref1_1_2)
            Set reference_line_ref1_2_3 = part1.CreateReferenceFromObject(line_ref1_2_3)
            Set reference_line_ref1_3_4 = part1.CreateReferenceFromObject(line_ref1_3_4)
            Set reference_line_ref1_4_1 = part1.CreateReferenceFromObject(line_ref1_4_1)
           
            Set proj1_1_2 = factory2D3.CreateProjection(reference_line_ref1_1_2)
            Set proj1_2_3 = factory2D3.CreateProjection(reference_line_ref1_2_3)
            Set proj1_3_4 = factory2D3.CreateProjection(reference_line_ref1_3_4)
            Set proj1_4_1 = factory2D3.CreateProjection(reference_line_ref1_4_1)

            Set ref_proj1_1_2 = part1.CreateReferenceFromObject(proj1_1_2)
            Set ref_proj1_2_3 = part1.CreateReferenceFromObject(proj1_2_3)
            Set ref_proj1_3_4 = part1.CreateReferenceFromObject(proj1_3_4)
            Set ref_proj1_4_1 = part1.CreateReferenceFromObject(proj1_4_1)

            Set constraints_dim = standard_body_sketch3.Constraints
            Set constraint_dx = constraints_dim.AddMonoEltCst(catCstTypeLength, ref_proj1_1_2)
            Set constraint_dy = constraints_dim.AddMonoEltCst(catCstTypeLength, ref_proj1_2_3)
            Set length_dx = constraint_dx.Dimension
            dx_value = length_dx.Value
            Set length_dy = constraint_dy.Dimension
            dy_value = length_dy.Value

            standard_body_sketch3.CloseEdition
            part1.Update

            ' Create the offset parameters
            Dim string_1 As String
            string_1 = "Offset_Bbox_Max_X." & j
            Dim string_2 As String
            string_2 = "Offset_Bbox_Min_X." & j
            Dim string_3 As String
            string_3 = "Offset_Bbox_Max_Y." & j
            Dim string_4 As String
            string_4 = "Offset_Bbox_Min_Y." & j
            Dim string_5 As String
            string_5 = "Offset_Bbox_Max_Z." & j
            Dim string_6 As String
            string_6 = "Offset_Bbox_Min_Z." & j
            Dim string_7 As String
            string_7 = "Bbox_dx." & j
            Dim string_8 As String
            string_8 = "Bbox_dy." & j
            Dim string_9 As String
            string_9 = "Bbox_dz." & j

            Dim Offset_Bbox_Max_X As RealParam
            Set Offset_Bbox_Max_X = part1.Parameters.CreateDimension(string_1, "Length", 0)
            Dim Offset_Bbox_Min_X As RealParam
            Set Offset_Bbox_Min_X = part1.Parameters.CreateDimension(string_2, "Length", 0)
            Dim Offset_Bbox_Max_Y As RealParam
            Set Offset_Bbox_Max_Y = part1.Parameters.CreateDimension(string_3, "Length", 0)
            Dim Offset_Bbox_Min_Y As RealParam
            Set Offset_Bbox_Min_Y = part1.Parameters.CreateDimension(string_4, "Length", 0)
            Dim Offset_Bbox_Max_Z As RealParam
            Set Offset_Bbox_Max_Z = part1.Parameters.CreateDimension(string_5, "Length", 0)
            Dim Offset_Bbox_Min_Z As RealParam
            Set Offset_Bbox_Min_Z = part1.Parameters.CreateDimension(string_6, "Length", 0)
            Set Bbox_dx_hidden = part1.Parameters.CreateDimension(string_7, "Length", dx_value)
            Set Bbox_dy_hidden = part1.Parameters.CreateDimension(string_8, "Length", dy_value)
            Set Bbox_dz_hidden = part1.Parameters.CreateDimension(string_9, "Length", length_dz.Value)
            Bbox_dx_hidden.Hidden = True
            Bbox_dy_hidden.Hidden = True
            Bbox_dz_hidden.Hidden = True
            Set Bbox_dx = part1.Parameters.CreateDimension(string_7, "Length", 0)
            Set Bbox_dy = part1.Parameters.CreateDimension(string_8, "Length", 0)
            Set Bbox_dz = part1.Parameters.CreateDimension(string_9, "Length", 0)
           
            Dim Formula_1 As Formula
            Set Formula_1 = part1.Relations.CreateFormula("formula_Bbox_1." & j, "", length14, "Offset_Bbox_Min_X." & j)
            Dim Formula_2 As Formula
            Set Formula_2 = part1.Relations.CreateFormula("formula_Bbox_2." & j, "", length12, "Offset_Bbox_Max_X." & j)
            Dim Formula_3 As Formula
            Set Formula_3 = part1.Relations.CreateFormula("formula_Bbox_4." & j, "", length11, "Offset_Bbox_Min_Y." & j)
            Dim Formula_4 As Formula
            Set Formula_4 = part1.Relations.CreateFormula("formula_Bbox_4." & j, "", length13, "Offset_Bbox_Max_Y." & j)
            Dim Formula_5 As Formula
            Set Formula_5 = part1.Relations.CreateFormula("formula_Bbox_5." & j, "", oEnd, " Offset_Bbox_Min_Z." & j)
            Dim Formula_6 As Formula
            Set Formula_6 = part1.Relations.CreateFormula("formula_Bbox_6." & j, "", oStart, " Offset_Bbox_Max_Z." & j)
            Dim Formula_7 As Formula
            Set Formula_7 = part1.Relations.CreateFormula("formula_Bbox_7." & j, "", Bbox_dx, "Bbox_dx." & j & "+Offset_Bbox_Min_X." & j & "+Offset_Bbox_Max_X." & j & "-2mm")
            Dim Formula_8 As Formula
            Set Formula_8 = part1.Relations.CreateFormula("formula_Bbox_8." & j, "", Bbox_dy, "Bbox_dy." & j & "+Offset_Bbox_Min_Y." & j & "+Offset_Bbox_Max_Y." & j & "-2mm")
            Dim Formula_9 As Formula
            Set Formula_9 = part1.Relations.CreateFormula("formula_Bbox_9." & j, "", Bbox_dz, "Bbox_dz." & j & "+Offset_Bbox_Min_Z." & j & "+Offset_Bbox_Max_Z." & j & "-2mm")

'----------------------------------------------------------------------------------------------------------------------------------
' Sweep the Z line around the XY boundary.  This will be closed
'----------------------------------------------------------------------------------------------------------------------------------
               
            Set sweepref_1 = part1.CreateReferenceFromObject(standard_body_sketch3)
            Set guide1 = part1.CreateReferenceFromObject(line_guide)
            Dim sweep1 As HybridShapeSweepExplicit
            Set sweep1 = hybridShapeFactory1.AddNewSweepExplicit(sweepref_1, guide1)
            hybridBody2.AppendHybridShape sweep1
            part1.InWorkObject = sweep1
            part1.Update

            ' Close the Sweep
            Set shapeFactory1 = part1.ShapeFactory
            Set hybridBodies1 = body1.HybridBodies
            Set hybridBody1 = hybridBodies1.Item("definition_points")
            Dim hybridShapes1 As HybridShapes
            Set hybridShapes1 = hybridBody1.HybridShapes
           
            Dim refer1 As Reference
            Set refer1 = part1.CreateReferenceFromObject(sweep1)
   
            Dim closeSurface1 As CloseSurface
            Set closeSurface1 = shapeFactory1.AddNewCloseSurface(refer1)
            closeSurface1.Name = "BoundingBox"
            part1.Update

            selection.Clear
            selection.Add hybridBody1
            selection.VisProperties.SetShow catVisPropertyNoShowAttr
            selection.Clear
            selection.Add body1
            selection.VisProperties.SetRealColor 0, 0, 0, 0
            selection.VisProperties.SetRealOpacity 150, 1
            selection.VisProperties.SetRealWidth 2, 1
            part1.Update
            axissyst.Name = "Bounding Box Axis." & j
           
        Else
            MsgBox "The active document must be a CATPart"
        End If

    End If

End Sub

---

Es geht um BoundingBox (Rohmass) für ein Body.

    Was ich möchte ist: berechnete X und Y und Z direkt am Parameter "Laenge", "Breite" und "Dicke" schreiben, wo X ist immer am größten Mass, dann Y usw. Ich will keine andere Änderungen im Part haben: keine Umbenenung, keine extra Geometrie hinzufugen.

    Wie kann ich der Code einfacher machen, mit meine Wünche?

Sorry für mein schlechtes Deutsch..

Gruß

Lucas

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus

Ohne extra Geometrie zu erzeugen geht es nicht (außer über Umwege). Diese könnte nach dem bestimmen der Abmessungen ja auch wieder gelöscht werden.
Willst du die Abmessungen nur einmal auslesen oder sollen sich die Parameter aktualisieren?
(die andern Diskussionen zu Bounding Box und Rohteil hast du schon durchgelesen?)

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von bgrittmann:
Servus

Ohne extra Geometrie zu erzeugen geht es nicht (außer über Umwege). Diese könnte nach dem bestimmen der Abmessungen ja auch wieder gelöscht werden.
Willst du die Abmessungen nur einmal auslesen oder sollen sich die Parameter aktualisieren?
(die andern Diskussionen zu Bounding Box und Rohteil hast du schon durchgelesen?)

Gruß
Bernd

---

Ja, klar! Die Geometrie kann natürlich Gelöscht werden.... Der Parameter ist nur Einmal gefüllt, als Text.

Alles was ich habe zur Zeit gelesen hat, hat immerwieder Problem mit CoG Achsenkreuz und hat funktioniert für den ganzen Part. Ich will das nur für spezifisches Body machen (entwickelt).

Gruß

Lucas

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus

Was meinst du mit Probleme mit dem Achsensystem?
Das Beispiel Makro geht nicht auf auf das ganze Part.
Wenn du einen bestimmten Körper nehmen willst, kannst du vermutlich die HybridShapeExtremum auch auf einen Körper "los lassen".

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

das hier sollte einpassendes Skript sein.
Es muss ein Achsensystem ausgewählt werden, und eine Face.

------------------
Sei Schlau bleib Dumm !!?!!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von K.Siebert:
Hallo,

das hier sollte einpassendes Skript sein.
Es muss ein Achsensystem ausgewählt werden, und eine Face.

---

Ich danke dir für deine Antwort. Gibt es Möglichkeit der Absolut Axis System von dem Part als Standardwert verwenden?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Grüß' dich,

ich hab dir im unten ein Script angehängt, dass deinen Wünschen
entsprechen sollte.

Der Ablauf ist so, dass du das Macro startest, dann den Körper auswählst,
auf dem du das Rohmaß willst und das Macro gibt dir dann das Rohmaß plus
entsprechend gerundetes Aufmaß zurück.

Ich habe es so gelöst, dass das Macro dafür ein geometrisches Set erzeugt,
die Achsen und Ebenen erstellt, dann alles vermisst und zum Schluss das Set
wieder löscht (damit alles wieder sauber aufgeräumt ist).

Wenn du nur Hauptkörper hast, dann kannst du dir es ja so umschreiben, dass
du nichts mehr auswählen musst, sondern direkt aufn Hauptkörper referenziert
wird.

Für Änderungen am Aufmaß musst du dir die Funktion createOffset anschauen und
dich mit den Variablen minOffset und roundStep spielen.

Damit alles Funktioniert muss der Paramter "Rohmass" in den Teileigenschaften
existieren, dorthin wird das Rohmaß als Zeichenkette geschrieben.

LG

Und: Ich kommt von C++ und Python, deshalb ist mein VB-Code ziemlich
unschön und unkonform.

Und 2: Ich empfehle dir fürs Coden Sublime Text mit VB-Syntax Highlighting.
Beim CATIA oder Windwos-Editor dreht man ja durch 

Code:

---

'--------------------------------------------------------------------------------
'
' Name      getBoundingBox.catvbs
' Version  0.0.4
' Created  2018.03.19
'
' Autor    P. Delorenzo
' Contact  p.delorenzo@indat.at
' Company  INDAT GmbH
' Licence  GNU GPLv3
'
' Use this script on your own risk.
'
' After the user has selected the body frm which the raw size (bounding box) shall
' be calculated, the script genereates the bounding box of it.
' Afterwards the raw size will be written into the depending field.
'
'--------------------------------------------------------------------------------

msgTitle = "Company name | Rohmass"

sub CATMain()

    on error resume next
        CATIA.ActiveDocument.save
    err.clear
    CATIA.StatusBar = "Company name | getBoundingBox.catvbs is running."

    dim activeRef(2)
    dim activeDirection(2)
    dim activeExtremum(5)
    dim activeRefPlanes(2)
    dim activeType(0)

    set properties = CATIA.ActiveDocument.GetItem(CATIA.ActiveDocument.Product.name).UserRefProperties
    'set relations = CATIA.ActiveDocument.GetItem(CATIA.ActiveDocument.Product.name).Relations
    'set parameters = CATIA.ActiveDocument.Product.Parameters

    ' Check if necesarry parameters are available
    propertieRawSizeAvailable = False
    for i = 1 to properties.count
        if inStr(1, properties.item(i).Name, "Rohmass") <> 0 then
            propertieRawSizeAvailable = True
        end if
    next

    if not propertieRawSizeAvailable then
        msgbox "Die Parameter sind nicht oder nicht ausreichend definiert." & vbCrLf & _
            "Es muss zuerst das Parameter-Script ausgeführt werden.", 0 + 16 + 65536 + 4096, "INDAT | Rohmass"
        exit sub
    end if

    activeType(0) = "Body"
    userSelection = CATIA.ActiveDocument.Selection.SelectElement2(activeType, "Körper für Rohmass auswählen [ESC=Abbruch]", False)
    set selectedBody = CATIA.ActiveDocument.Selection.item(1).Value
    set selectedPart = selectedBody.Parent.Parent
    CATIA.ActiveDocument.Selection.clear

    ' Check if axis system or geometrical set exists, if so: delete them
    set activeHybridBdys = selectedPart.HybridBodies
    set activeAxisSystems = selectedPart.AxisSystems
    set deleteSelection = CATIA.ActiveDocument.Selection
    for i = 1 to activeHybridBdys.count
        if InStr(1, activeHybridBdys.item(i).Name, "Bounding Box") then
            deleteSelection.add activeHybridBdys.item(i)
        end if
    next
    for i = 1 to activeAxisSystems.count
        if inStr(1, activeAxisSystems.item(i).Name, "BoundingBoxAxisSystem") then
            deleteSelection.add activeAxisSystems.item(i)
        end if
    next
    if deleteSelection.count > 0 then
        deleteSelection.Delete
        deleteSelection.clear
    end if
   
    ' Create axis system
    set activeAxisSystem = activeAxisSystems.add()
    activeAxisSystem.Name = "BoundingBoxAxisSystem"
    selectedPart.Update

    ' Get directions
    set activeHybridShapeFactory = selectedPart.HybridShapeFactory
    set activeRef(0) = selectedPart.CreateReferenceFromBRepName("RSur:(Face:(Brp:(" & activeAxisSystem.GetItem("ModelElement").InternalName & ";1);None:();Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", activeAxisSystem)
    set activeRef(1) = selectedPart.CreateReferenceFromBRepName("RSur:(Face:(Brp:(" & activeAxisSystem.GetItem("ModelElement").InternalName & ";2);None:();Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", activeAxisSystem)
    set activeRef(2) = selectedPart.CreateReferenceFromBRepName("RSur:(Face:(Brp:(" & activeAxisSystem.GetItem("ModelElement").InternalName & ";3);None:();Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", activeAxisSystem)
    set activeDirection(0) = activeHybridShapeFactory.AddNewDirection(activeRef(0))
    set activeDirection(1) = activeHybridShapeFactory.AddNewDirection(activeRef(1))
    set activeDirection(2) = activeHybridShapeFactory.AddNewDirection(activeRef(2))

    ' Create gemeoetrical set
    set activeHybridBdy = activeHybridBdys.add()
    activeHybridBdy.Name = "Bounding Box"
    selectedPart.InWorkObject = activeHybridBdy

    ' Get min and max extremum
    for i = 0 to 2
        set activeRefBdy = selectedPart.CreateReferenceFromObject(selectedBody)
        set activeExtremum((i * 2) + 0) = activeHybridShapeFactory.AddNewExtremum(activeRefBdy, activeDirection(i), 0)
        activeExtremum((i * 2) + 0).Name = "Extremum " & (i * 2) + 0
        activeHybridBdy.AppendHybridShape activeExtremum((i * 2) + 0)
        activeExtremum((i * 2) + 0).Compute
        set activeRefBdy = selectedPart.CreateReferenceFromObject(selectedBody)
        set activeExtremum((i * 2) + 1) = activeHybridShapeFactory.AddNewExtremum(activeRefBdy, activeDirection(i), 1)
        activeExtremum((i * 2) + 1).Name = "Extremum " & (i * 2) + 1
        activeHybridBdy.AppendHybridShape activeExtremum((i * 2) + 1)
        activeExtremum((i * 2) + 1).Compute
    next

    ' Get center of mass
    set activePoint = createCenter(selectedBody, selectedPart, activeHybridShapeFactory)
    activePoint.Name = "Center Point"
    activeHybridBdy.AppendHybridShape activePoint

    ' Generate reference planes
    for i = 0 to 2
        set activeRefPlanes(i) = activeHybridShapeFactory.AddNewPlaneOffsetPt(activeRef(i), activePoint)
        activeRefPlanes(i).Name = "Reference Plane " & i
        activeRefPlanes(i).Compute
        activeHybridBdy.AppendHybridShape activeRefPlanes(i)
    next

    ' Calculate dimensional values
    zValue = Abs(measureExtremum(activeRefPlanes(0), activeExtremum(0)) + measureExtremum(activeRefPlanes(0), activeExtremum(1)))
    xValue = Abs(measureExtremum(activeRefPlanes(1), activeExtremum(2)) + measureExtremum(activeRefPlanes(1), activeExtremum(3)))
    yValue = Abs(measureExtremum(activeRefPlanes(2), activeExtremum(4)) + measureExtremum(activeRefPlanes(2), activeExtremum(5)))

    ' Output
    msg = "Ermittelte Werte bezogen auf: " & activeAxisSystem.Name & vbCrLf & vbCrLf & vbCrLf
    msg = msg & "X-Richtung: " & Round(xValue, 2) & " mm" & vbCrLf
    msg = msg & "Y-Richtung: " & Round(yValue, 2) & " mm" & vbCrLf
    msg = msg & "Z-Richtung: " & Round(zValue, 2) & " mm" & vbCrLf
    msg = msg & vbCrLf
    msg = msg & "X-Aufmaß: " & createOffset(Round(xValue, 2)) & " mm" & vbCrLf
    msg = msg & "Y-Aufmaß: " & createOffset(Round(yValue, 2)) & " mm" & vbCrLf
    msg = msg & "Z-Aufmaß: " & createOffset(Round(zValue, 2)) & " mm" & vbCrLf
    msg = msg & vbCrLf & vbCrLf & "Sollen diese Werte festgeschrieben werden?"
    response = msgbox(msg, 4 + 32 + 65536 + 4096, msgTitle)

    ' Hide geometrical set and axis system
    set hideSelection = CATIA.ActiveDocument.Selection
    hideSelection.Add activeAxisSystem
    hideSelection.Add activeHybridBdy
    set hideSet = hideSelection.VisProperties
    hideSet.SetShow 1

    ' Write values to parameter
    if response = 6 then
        xyzValues = sortValues(Round(xValue, 2), Round(yValue, 2), Round(zValue, 2))
        for i = 1 to properties.count
            if InStr(1, properties.Item(i).Name, "Rohmass") and InStr(1, properties.Item(i).Name, "Anmerkung") = 0 then
                properties.Item(i).Value = xyzValues
            end if
            if InStr(1, properties.Item(i).Name, "Anmerkung Rohmass") then
                properties.Item(i).Value = replace(properties.Item(i).Value, "Feinstgefräst", "")
            end if
        next
    end if

    set deleteSelection = CATIA.ActiveDocument.Selection
    for i = 1 to activeHybridBdys.count
        if InStr(1, activeHybridBdys.Item(i).Name, "Bounding Box") then
            deleteSelection.Add activeHybridBdys.Item(i)
        end if
    Next
    if deleteSelection.count > 0 then
        deleteSelection.Delete
    end if

    on error resume next
        CATIA.ActiveDocument.save
    err.clear
end sub

function measureExtremum(referencePlane, extremum)
    ' Takes:        plane, value
    ' Returns:      value
    ' Description:  Get the extremum of measurement

    set spaWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
    set measurement = spaWorkbench.GetMeasurable(referencePlane)
    measureExtremum = measurement.GetMinimumDistance(extremum)
end function

function createCenter(selectedBody, selectedPart, activeHybridShapeFactory)
    ' Takes:        body, part, env
    ' Returns:      point
    ' Description:  Get the center of the selected part
   
    dim coordsystem(2)

    set activeRef = selectedPart.CreateReferenceFromObject(selectedBody)
    set spaWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
    set measurement = spaWorkbench.GetMeasurable(activeRef)
    measurement.GetCOG coordsystem
    set createCenter = activeHybridShapeFactory.AddNewPointCoord(coordsystem(0), coordsystem(1), coordsystem(2))
    createCenter.Compute
end function

function createOffset(offsetVal)
    ' Takes:        value
    ' Returns:      value
    ' Description:  Creates an offset to the minimum bounding box
   
    ' Offset variables
    minOffset = 3  ' Min. offset of 3 mm
    roundStep = 5  ' Round in 5-step
    ' Calculate offset
    dStep = (roundStep / 2) - 0.01
    createOffset = Round((offsetVal + minOffset + dStep) / roundStep, 0) * roundStep
end function

function sortValues(xVal, yVal, zVal)
    ' Takes:        value, value, value
    ' Returns:      string
    ' Description:  Sort values and return string
   
    dim valBuffer(3)
    valBuffer(0) = xVal
    valBuffer(1) = yVal
    valBuffer(2) = zVal
    For i = 0 To UBound(valBuffer) - 1
        For j = i + 1 To UBound(valBuffer) - 1
            If valBuffer(i) < valBuffer(j) Then
                srtTemp = valBuffer(j)
                valBuffer(j) = valBuffer(i)
                valBuffer(i) = srtTemp
            End If
        Next
    Next
    sortValues = cstr(createOffset(valBuffer(0))) & "x" & cstr(createOffset(valBuffer(1))) & "x" & createOffset(cstr(valBuffer(2)))
end function

---

------------------
Use a git repo for your code, you're welcome!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus Sylas

Zum Thema Standardachsensystem sollte folgende Ansätze gehen:

• per AxisSystems-Collection auf das erste bzw aktuelle zugreifen
  
• bei den AddNewDirectionByCoord direkt die Vektoren der Hauptrichtungen angeben
  
• die Richtungen aus den OriginElements erstellen

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Eigenschaften.JPG Formel.JPG

Hallo i030

erstmal besten Dank für das Macro, Punkte sind unterwegs.
Es läuft bei mir durch bis zu der Meldung, sollen die Werte festgeschrieben werden. Leider werden die Werte nicht in die Eigenschaften Rohmass übernommen. Woran könnte das liegen. 2 Bilder hab ich mit angehängt vielleicht ist daraus der Fehler meinerseits zu erkennen.
Vorab besten Dank für die Hilfe.
mfg
me23

------------------
mfg    
me23

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus

Hat der Parameter "Rohmass" auch den Typ Zeichenkette bzw String?

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Bernd

Zeichenkette find ich nicht, ich hatte mal Zeichnefolge drin. Wie und wo kann ich das überprüfen das das stimmt?

Die Eigenschaften werden über das folgende Macro eingetragen wo ein Kollege mal geschrieben hat.

---------------------------------------------------------------
Language="VBSCRIPT"

Sub CATMain()

Set partDocument1 = CATIA.ActiveDocument

Set product1 = partDocument1.GetItem("12-97D303172_RPS_001_003_TE_Platte")

Set parameters1 = product1.UserRefProperties

Set strParam1 = parameters1.CreateString("Rohmass", "")

strParam1.ValuateFromString ""

Set parameters2 = product1.UserRefProperties

Set strParam2 = parameters2.CreateString("MATERIAL", "")

strParam2.ValuateFromString ""

Set product1 = product1.ReferenceProduct

Set product1 = product1.ReferenceProduct

Set part1 = partDocument1.Part

Set relations1 = part1.Relations

Set formula1 = relations1.CreateFormula("Formel.1", "", strParam2, "Material ")

formula1.Rename "Formel.1"

part1.Update

End Sub

---------------------------------------------------------------

Danke
mfg
me23

------------------
mfg    
me23

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus

Der Typ des Parameters stimmt.
Startest du das Makro bei einem geöffneten CATPart (in eigenem Fenster)?
Ersetze mal im Code err.clear durch On Error GoTo 0.
Kommt nun eine Fehlermeldung?

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Fehlermeldung.JPG

Guten Morgen Bernd

Part geöffnet und das Makro wird gestartet. Hauptkörper wird angewählt.
Wie gesagt es läuft durch bis zu der Meldung, sollen die Masse festgeschrieben werden, mit Ja bestätigt werden dannn aber nicht in die eigenschaften übernommen.
Den Code hab ich erstetzt, dann kommt eine Fehlermeldung. Siehe Bild
Ich hab das auch jetz in V5 R19 und V5 R26 versucht, geht bei beiden nich. Auch an dem Rechner von meinem Kollegen.

mfg
me23

------------------
mfg    
me23

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus me23

Bei mir läuft das Makro in R19 durch (auch ohne Änderung).
Du hast schon das unterer Makro in dieser Diskussion verwendet, oder?
Nach On Error Goto 0 darf kein Punkt kommen!

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Bernd

erst mal Entschuldigung, weil ich hab das selber verbockt. Erst überlegen dann schreiben.
Ich hab das Aufmass auf Null gesetzt und dabei wohl irgendwas falsch gemacht.
Vielen dank für Deine schnelle Hilfe.
Jetzt weiß ich wenigsten wo ich ansetzen muß.
Hoffe ich bekomm das vollends so hin.
Wenn nicht, würd ich mich nochmals melden.

mfg
me 23

------------------
mfg    
me23

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

catia-getrawsize-mask.jpg

Grüß' euch,

erstmal danke fürs Antworten auf meinen Code,
ich hab' in der Zwischenzeit das Macro recht stark
überarbeitet, das läuft jetzt mit einer HTA-Maske,
siehe Anhang.

Falls Interesse besteht, dann lade ich den Code mal
hoch, dazu ist aber etwas mehr zu sagen (eventuell
mache ich dann einen eigenen Thread auf).

LG

------------------
Use a git repo for your code, you're welcome!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP