Text dotazu:
Zdravím,

Posielam Makro, ktoré vytvorí znak AUDI, stačí zadať priemer kružníc.
Nie je to samozrejme žiaden "ohurovák", ale aby reč nestála.
Možno sa niekomu hodí, kto začína a spoznáva kód.

Majte sa

PS: možno upravením by sa to hodilo aj na najbližšiu olympiádu :o)

Sub CATMain()



 Dim radius As Double

    radius = InputBox("Ahoj :o)" & vbCrLf & vbCrLf & _

                        "Toto je Makro" & vbCrLf & _

                        "Vykreslí znak AUDI" & vbCrLf & vbCrLf & _

                        "Zadajte polomer kružníc:", _

                        "AUDI","40")



	If radius="" Then Exit sub







Dim oDoc As Document

Set oDoc = catia.Documents.Add("Part")



Dim oPart As Part

Set oPart = oDoc.Part



Dim oProd As Product

Set oProd = oDoc.Product



    On Error Resume Next

    catia.ActiveDocument.Product.PartNumber = "AUDI"

    ierr = Err.Number

    

    If ierr <> 0 Then 



    	On Error GoTo 0

    	catia.ActiveDocument.Product.PartNumber = "AUDI"



    End if



Dim oPlaneXY As Reference

Set oPlaneXY = oPart.CreateReferenceFromGeometry(oPart.OriginElements.PlaneXY)



Dim oSketch As Sketch

Set oSketch = oPart.Bodies.Item(1).Sketches.Add(oPlaneXY)



 Set myAxis = oSketch.AbsoluteAxis



Dim oFactory2D As Factory2D

Set oFactory2D = oSketch.OpenEdition



   

    

    r = radius + radius / 2

    

    Dim distance As Double

    distance = radius



    For i = 1 To 4

    

        Dim oCircle As Circle2D

        Set oCircle = oFactory2D.CreateClosedCircle(0, radius, distance)

    

        radius = radius + r

    

    Next



Dim oFactory As ShapeFactory

Set oFactory = oPart.ShapeFactory



Dim oPad As PAD

Set oPad = oFactory.AddNewPad(oSketch, r / 7)

oPad.IsThin = True

oPad.NeutralFiber = True

Dim parameters1 As Parameters

Set parameters1 = oPart.Parameters

parameters1.Item(5).Value = r / 7



Dim oSelec As Selection

Set oSelec = catia.ActiveDocument.Selection



oSelec.Add oPad



Dim oVisPro As VisPropertySet

Set oVisPro = oSelec.VisProperties



oVisPro.SetRealColor 30, 100, 180, 1



    Dim oRef As Reference

    Set oRef = oPart.CreateReferenceFromName("")

    

    Dim oFillet As ConstRadEdgeFillet

    Set oFillet = oFactory.AddNewSolidEdgeFilletWithConstantRadius(oRef, catTangencyFilletEdgePropagation, r / 25)

    

Dim reference1 As Reference

Set reference1 = oPart.CreateReferenceFromBRepName("RSur:(Face:(Brp:(Pad.1;2);None:();Cf9:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", oPad)



oFillet.AddObjectToFillet reference1



Dim reference2 As Reference

Set reference2 = oPart.CreateReferenceFromBRepName("RSur:(Face:(Brp:(Pad.1;1);None:();Cf9:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", oPad)



oFillet.AddObjectToFillet reference2



oSelec.Clear

oSelec.Search (".plane")

oVisPro.SetShow catVisPropertyNoShowAttr



oSelec.Clear

oPart.Update





Dim oVie As Viewer

Set oVie = catia.ActiveWindow.ActiveViewer

oVie.Reframe

oVie.FullScreen = True

osketch.closeedition



End Sub