Attribute VB_Name = "CreateAxisLineAndPoint_v1"
Sub CATMain()

    'by Daniel Frauenrath
    '17.08.2010

    'DEKLARIERUNGEN
    Dim intPartDocObj As PartDocument
    Dim intPartObj As Part
    Dim intProdObj As Product
    Dim intHybShapFacObj As HybridShapeFactory
    Dim intHoleBodyObj As Body
    Dim intShapesObj As Shapes
    Dim intHoleObj As Object
    Dim intHoleRefObj As Reference
    Dim intAxisLineObj As HybridShapeAxisLine
    Dim intHybBodiesObj As HybridBodies
    Dim intHybBodyObj As HybridBody
    Dim intHybShapesObj As HybridShapes
    Dim intInitialPlaneObj As HybridShapePlaneOffset
    Dim intIntersectObj As HybridShapeIntersection
    Dim intAxisRefInterObj As Reference
    Dim intPlaneRefInterObj As Reference
    Dim intPubliRefObj As Reference
    Dim intPublicationsObj As Object
    Dim intPubliObj As Publication



    'BENÖTIGTE OBJECTE
    Set intPartDocObj = CATIA.ActiveDocument
    Set intPartObj = intPartDocObj.Part
    Set intHybShapFacObj = intPartObj.HybridShapeFactory
    Set intHoleBodyObj = intPartObj.Bodies.Item("Body.BOHRUNGEN")
    Set intShapesObj = intHoleBodyObj.Shapes
    Set intHybBodiesObj = intPartObj.HybridBodies
    Set intHybBodyObj = intHybBodiesObj.Item("WEITERGABEGEOMETRIE__")
    Set intHybShapesObj = intHybBodyObj.HybridShapes
    Set intInitialPlaneObj = intHybShapesObj.Item("Plane.INITIAL_PLANE_HOLES")
    Set intProdObj = intPartObj.Parent.Product
    Set intPublicationsObj = intProdObj.Publications
    
    'PUBLIKATION EBENE
    Set intPubliRefObj = intProdObj.CreateReferenceFromName(intProdObj.Name & "/!" & intInitialPlaneObj.Name)
    Set intPubliObj = intPublicationsObj.Add(intInitialPlaneObj.Name)
    intPublicationsObj.SetDirect CStr(intInitialPlaneObj.Name), intPubliRefObj
    
    'REFERENZ AUF EBENE ERSTELLEN
    Set intPlaneRefInterObj = intPartObj.CreateReferenceFromObject(intInitialPlaneObj)
    
    'SCHLEIFE ZUR ERSTELLUNG VON ACHSEN UND PUNKTEN
    For Each intHoleObj In intHoleBodyObj.Shapes
        'TYP ABFRAGE UM REFERENZELEMENT ZU LESEN
        If TypeName(intHoleObj) = "Hole" Then
            Set intHoleRefObj = intPartObj.CreateReferenceFromObject(intHoleObj)
        Else
            Set intHoleRefObj = GetAxisReferenceFunc(intPartObj, intHoleObj)
        End If
        
        'ACHSE DURCH BOHRUNG ERSTELLEN
        Set intAxisLineObj = intHybShapFacObj.AddNewAxisLine(intHoleRefObj)
        intAxisLineObj.AxisLineType = 1
        intAxisLineObj.Name = "Axis." & intHoleObj.Name
        intHybBodyObj.AppendHybridShape intAxisLineObj
        
        'VERSCHNEIDUNG = PUNKT ERSTELLEN
        Set intAxisRefInterObj = intPartObj.CreateReferenceFromObject(intAxisLineObj)
        Set intIntersectObj = intHybShapFacObj.AddNewIntersection(intAxisRefInterObj, intPlaneRefInterObj)
        intIntersectObj.PointType = 0
        intHybBodyObj.AppendHybridShape intIntersectObj
        intIntersectObj.Name = "Point." & intHoleObj.Name
        
        'PART UPDATEN
        intPartObj.Update
        
        'PUBLIZIEREN
        Set intPubliRefObj = intProdObj.CreateReferenceFromName(intProdObj.Name & "/!" & intAxisLineObj.Name)
        Set intPubliObj = intPublicationsObj.Add(intAxisLineObj.Name)
        intPublicationsObj.SetDirect CStr(intAxisLineObj.Name), intPubliRefObj
        
        Set intPubliRefObj = Nothing
        
        Set intPubliRefObj = intProdObj.CreateReferenceFromName(intProdObj.Name & "/!" & intIntersectObj.Name)
        Set intPubliObj = intPublicationsObj.Add(intIntersectObj.Name)
        intPublicationsObj.SetDirect CStr(intIntersectObj.Name), intPubliRefObj
        
    Next
    
    'AUSGABE
    MsgBox "Das Makro wurde erfolgreich beendet", vbInformation, "MAKRO BEENDET"

End Sub

Private Function GetAxisReferenceFunc(ByVal uebPartObj As Part, ByVal uebPatternObj As RectPattern) As Reference

    'DEKLARATIONEN
    Dim intPatternRefObj As Reference
    Dim intPatternModelEleObj As ModelElement
    Dim intHoleModelEleObj As ModelElement
    Dim intSketchModelEleObj As ModelElement
    Dim intPatternNameStr As String
    Dim intHoleNameStr As String
    Dim intSketchNameRAWStr As String
    Dim intSketchNameSEMIStr() As String
    Dim intSketchCountLng As Long
    Dim intSketchNameStr As String
    Dim intParentObj As Object
    Dim intRefStr As String
    
    'MODEL ELEMENT OBJEKT HOLEN
    Set intModelElementObj = uebPatternObj.GetItem("ModelElement")
    Set intHoleModelEleObj = uebPatternObj.ItemToCopy.GetItem("ModelElement")
    Set intSketchModelEleObj = uebPatternObj.ItemToCopy.Sketch.GetItem("ModelElement")
    
    'NAMEN AUSLESEN
    intPatternNameStr = intModelElementObj.InternalName
    intHoleNameStr = intHoleModelEleObj.InternalName
    intSketchNameRAWStr = intSketchModelEleObj.InternalName
    intSketchNameSEMIStr = Split(intSketchNameRAWStr, ".")
    intSketchCountLng = CLng(intSketchNameSEMIStr(UBound(intSketchNameSEMIStr)))
    intSketchNameStr = intSketchNameSEMIStr(0) & "." & CStr(intSketchCountLng + 1)
    
    'PARENT AUSLESEN
    Set intParentObj = uebPartObj.MainBody.Shapes.Item(2)

    'REFERENZ ERSTELLEN
    intRefStr = "RSur:(Face:(Brp:(" & intPatternNameStr & "_ResultOUT;1-0:(Brp:(" & intHoleNameStr & ";0:(Brp:(" & intSketchNameStr & ";3)))));None:();Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)"
    Set intPatternRefObj = uebPartObj.CreateReferenceFromBRepName(intRefStr, intParentObj)
    
    
    Set GetAxisReferenceFunc = intPatternRefObj
End Function

