Datum:
30.8. 2012
| Zobrazeno:
11303xKonfigurace CATIA: 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
