Catia Flower
Catia Flower
'''''
'''''''''''''''''''''''''''''
Sub Flower()
'Created by Alireza Reihani
Dim X0 As Double
Dim Y0 As Double
Dim Z0 As Double
X0 = 100
X0 = Val(FrmFlower.TxtX0.Text)
Y0 = 100
Y0 = Val(FrmFlower.TxtY0.Text)
Z0 = 0
Dim R1 As Double
Dim R12 As Double
Dim H1 As Double
Dim H2 As Double
Dim H As Double
Dim SweepR As Double
Dim OffsetPlane As Double
Dim R2 As Double
Dim RHole As Double
Dim DistHole As Double
Dim QtyHole As Integer
Dim RFillet As Double
Dim DeltaX As Double
Dim DeltaY As Double
Dim RS1 As Double
Dim RS2 As Double
Dim RS3 As Double
Dim RS4 As Double
Dim RS5 As Double
Dim RS6 As Double
Dim RS7 As Double
Dim XS1 As Double
Dim YS1 As Double
Dim XS2 As Double
Dim YS2 As Double
Dim XS3 As Double
Dim YS3 As Double
Dim XS4 As Double
Dim YS4 As Double
Dim XS5 As Double
Dim YS5 As Double
Dim XS6 As Double
Dim YS6 As Double
Dim XS7 As Double
Dim YS7 As Double
Dim Alfa1Start As Double
Dim Alfa1End As Double
Dim Alfa2Start As Double
Dim Alfa2End As Double
Dim Alfa3Start As Double
Dim Alfa3End As Double
Dim Alfa4Start As Double
Dim Alfa4End As Double
Dim Alfa5Start As Double
Dim Alfa5End As Double
Dim Alfa6Start As Double
Dim Alfa6End As Double
Dim Alfa7Start As Double
Dim Alfa7End As Double
H1 = 100
H2 = 100
H = Val(FrmFlower.TxtH.Text)
H1 = H / 2
H2 = H1
SweepR = 10
SweepR = Val(FrmFlower.TxtSweepR.Text) / 2
OffsetPlane = 20
OffsetPlane = Val(FrmFlower.TxtOffsetPlane.Text)
DistHole = 12
DistHole = Val(FrmFlower.TxtDistHole.Text) / 2
QtyHole = 10
QtyHole = Val(FrmFlower.TxtQtyHole.Text)
RFillet = 1
DeltaX = -143
DeltaX = -Val(FrmFlower.TxtDeltaX.Text)
DeltaY = 30
DeltaY = Val(FrmFlower.TxtDeltaY.Text)
RS1 = 0.6
RS2 = 0.5
RS3 = 27.11
RS4 = 32.88
RS5 = 29.86
RS6 = 21.36
RS7 = 4
XS1 = -0.1
YS1 = -0.1
XS2 = -0.02
YS2 = -1.42
XS3 = -1.34
YS3 = 19.07
XS4 = -2.36
YS4 = 14.58
XS5 = -2.42
YS5 = 6.89
XS6 = -0.24
YS6 = 5.92
XS7 = -0.17
YS7 = 1.99
Alfa1Start = 150.14
Alfa1End = 379.26
Alfa2Start = 176.83
Alfa2End = 363.18
Alfa3Start = 223.57
Alfa3End = 312.88
Alfa4Start = 208.38
Alfa4End = 328.86
Alfa5Start = 195.28
Alfa5End = 342.77
Alfa6Start = 198.45
Alfa6End = 336.21
Alfa7Start = 184.39
Alfa7End = 357.19
Dim myPlaneXobj
Set myPlaneXobj = RefmyPlaneX
myPart.Update
' Create Sketch Object --------------------
'Arc1
'Arc2
Dim alfaRad2 As Double
alfaRad2 = Atn((H2 / 2) / Sqr(R12 ^ 2 - (H2 / 2) ^ 2))
Dim Xcen2 As Double
If FlowerDirection = True Then
Xcen2 = Y0 + Sqr(R1 ^ 2 - (H2 / 2) ^ 2)
Else
Xcen2 = Y0 - Sqr(R1 ^ 2 - (H2 / 2) ^ 2)
End If
mySketch.CloseEdition
myPart.Update
myHB3.AppendHybridShape mySweepCircle
myPart.Update
myPart.Update
mySketch2.CloseEdition
myPart.Update
'Step 4-6: Create Blend
myPart.Update
'''''''Create Blend
Dim RefCurveBlend1 As Reference
Set RefCurveBlend1 =
myPart.CreateReferenceFromObject(myHybridShapeIntersection)
Dim RefCurveBlend2 As Reference
Set RefCurveBlend2 = myPart.CreateReferenceFromObject(mySketch2)
Dim RefmyExtremumPointIntersection As Reference
Set RefmyExtremumPointIntersection =
myPart.CreateReferenceFromObject(myExtremumPointIntersection)
Dim RefmyExtremumPointSketch2 As Reference
Set RefmyExtremumPointSketch2 =
myPart.CreateReferenceFromObject(myExtremumPointSketch2)
Dim RefSupport1 As Reference
Set RefSupport1 = myPart.CreateReferenceFromObject(mySweepCircle)
myPart.Update
'' Bump
Dim RefBoundaryBump As Reference
Set RefBoundaryBump = myPart.CreateReferenceFromObject(myProjectSketch2)
'Step 4-9-1: Create Center Point Bump
Dim myCenterBumpPoint As HybridShapePointCenter
Set myCenterBumpPoint = HSF.AddNewPointCenter(RefBoundaryBump)
myHB.AppendHybridShape myCenterBumpPoint
myPart.Update
'''''''''''''''''''''''''
myPart.Update
Set RefPtCenterHole =
myPart.CreateReferenceFromObject(myCenterHolePoint)
HSF.GSMVisibility RefmyHoleProject, 0
HSF.GSMVisibility RefCutter, 0
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''Create 7 Holes
Dim Alfa As Double
Alfa = 0
For i = 1 To QtyHole - 1
Alfa = Alfa + 360 / QtyHole
Set myCenterHolePoint = HSF.AddNewPointOnPlane(RefPlaneHole,
DistHole * Cos(Alfa * Pi / 180), DistHole * Sin(Alfa * Pi / 180))
myCenterHolePoint.Point = RefCenterBump
myHB.AppendHybridShape myCenterHolePoint
myPart.Update
Set RefPtCenterHole =
myPart.CreateReferenceFromObject(myCenterHolePoint)
Set RefSurfaceProject =
myPart.CreateReferenceFromObject(mySplit)
Set RefmyHoleProject =
myPart.CreateReferenceFromObject(myCircleHole)
'Step 5: Flower
myPart.Update
myPart.Update
myPart.Update
myPart.Update
'Step 5-5: Create Plane Perp. to Flower Line through Start Point
Dim RefmyFlowerLine As Reference
Set RefmyFlowerLine = myPart.CreateReferenceFromObject(myFlowerLine)
Dim myPlaneNormaltoFlowerLine As HybridShapePlaneNormal
Set myPlaneNormaltoFlowerLine = HSF.AddNewPlaneNormal(RefmyFlowerLine,
RefPtExtYSketch2)
myHB.AppendHybridShape myPlaneNormaltoFlowerLine
myPart.Update
'Step 5-6: Create Plane Perp. to Flower Line through End Point
Dim myPlaneNormaltoFlowerLineEnd As HybridShapePlaneNormal
Set myPlaneNormaltoFlowerLineEnd = HSF.AddNewPlaneNormal(RefmyFlowerLine,
RefPtEndFlower)
myHB.AppendHybridShape myPlaneNormaltoFlowerLineEnd
myPart.Update
myPart.Update
myPart.Update
myPart.Update
'Create Extremum Point of Arc1
Dim RefExtArc1 As Reference
Set RefExtArc1 = myPart.CreateReferenceFromObject(myArc1)
myPart.Update
myPart.Update
'Arc2
Dim myCenterPointArc2 As HybridShapePointOnPlane
Set myCenterPointArc2 = HSF.AddNewPointOnPlane(RefPlaneS2, XS2, YS2)
myCenterPointArc2.Point = RefPtExtYSketch2
myHB.AppendHybridShape myCenterPointArc2
myPart.Update
myPart.Update
myPart.Update
'Arc3
Dim myCenterPointArc3 As HybridShapePointOnPlane
Set myCenterPointArc3 = HSF.AddNewPointOnPlane(RefPlaneS3, XS3, YS3)
myCenterPointArc3.Point = RefPtExtYSketch2
myHB.AppendHybridShape myCenterPointArc3
myPart.Update
myPart.Update
myPart.Update
myPart.Update
'Arc4
Dim myCenterPointArc4 As HybridShapePointOnPlane
Set myCenterPointArc4 = HSF.AddNewPointOnPlane(RefPlaneS4, XS4, YS4)
myCenterPointArc4.Point = RefPtExtYSketch2
myHB.AppendHybridShape myCenterPointArc4
myPart.Update
myPart.Update
myPart.Update
myPart.Update
'Arc5
Dim myCenterPointArc5 As HybridShapePointOnPlane
Set myCenterPointArc5 = HSF.AddNewPointOnPlane(RefPlaneS5, XS5, YS5)
myCenterPointArc5.Point = RefPtExtYSketch2
myHB.AppendHybridShape myCenterPointArc5
myPart.Update
myPart.Update
myPart.Update
myPart.Update
'Arc6
Dim myCenterPointArc6 As HybridShapePointOnPlane
Set myCenterPointArc6 = HSF.AddNewPointOnPlane(RefPlaneS6, XS6, YS6)
myCenterPointArc6.Point = RefPtExtYSketch2
myHB.AppendHybridShape myCenterPointArc6
myPart.Update
myPart.Update
myPart.Update
'Arc7
Dim myCenterPointArc7 As HybridShapePointOnPlane
Set myCenterPointArc7 = HSF.AddNewPointOnPlane(RefPlaneS7, XS7, YS7)
myCenterPointArc7.Point = RefPtExtYSketch2
myHB.AppendHybridShape myCenterPointArc7
myPart.Update
myPart.Update
myPart.Update
myPart.Update
myDownSpline.AddPoint myExtremumPointArc1
myDownSpline.AddPoint myExtremumPointArc3
myDownSpline.AddPoint myExtremumPointArc4
myDownSpline.AddPoint myExtremumPointArc5
myDownSpline.AddPoint myExtremumPointArc6
myDownSpline.AddPoint myExtremumPointArc7
myDownSpline.AddPoint myExtremumPointArc2
myHB.AppendHybridShape myDownSpline
myPart.Update
myLeftSpline.AddPoint myLeftPtArc1
myLeftSpline.AddPoint myLeftPtArc3
myLeftSpline.AddPoint myLeftPtArc4
myLeftSpline.AddPoint myLeftPtArc5
myLeftSpline.AddPoint myLeftPtArc6
myLeftSpline.AddPoint myLeftPtArc7
myLeftSpline.AddPoint myLeftPtArc2
myHB.AppendHybridShape myLeftSpline
myPart.Update
myRightSpline.AddPoint myRightPtArc1
myRightSpline.AddPoint myRightPtArc3
myRightSpline.AddPoint myRightPtArc4
myRightSpline.AddPoint myRightPtArc5
myRightSpline.AddPoint myRightPtArc6
myRightSpline.AddPoint myRightPtArc7
myRightSpline.AddPoint myRightPtArc2
myHB.AppendHybridShape myRightSpline
myPart.Update
myHB3.AppendHybridShape myFlowerLoft
myPart.Update
'Step 5 - 11-1: Petal Color
Dim MyListPetal0 As Selection
Set MyListPetal0 = CATIA.ActiveDocument.Selection
MyListPetal0.Clear
MyListPetal0.Add myFlowerLoft
MyListPetal0.VisProperties.SetRealColor R_Petal1, G_Petal1,
B_Petal1, 1
myPart.Update
myCircPattern1.ItemToCopy = anyObject2
Set hybridShapePlaneOffset1 = myOffsetPlane
Set Reference3 =
myPart.CreateReferenceFromObject(hybridShapePlaneOffset1)
myCircPattern1.SetRotationAxis Reference3
myPart.UpdateObject myCircPattern1
myPart.Update
'Step 5-13: Create Circular Pattern of Petal
Dim anyObject11 As AnyObject
Set anyObject11 = myPlaneNormaltoSketch2
myCircPattern11.ItemToCopy = anyObject22
Set hybridShapePlaneOffset11 = myPlaneNormaltoSketch2
Set Reference33 =
myPart.CreateReferenceFromObject(hybridShapePlaneOffset11)
myCircPattern11.SetRotationAxis Reference33
myPart.UpdateObject myCircPattern11
myPart.Update
HSF.GSMVisibility ReftoRotate, 0
myPart.Update
myPart.Update
myCircPattern3.ItemToCopy = anyObject222
Set hybridShapePlaneOffset1 = myOffsetPlane
Set Reference3 =
myPart.CreateReferenceFromObject(hybridShapePlaneOffset1)
myCircPattern3.SetRotationAxis Reference3
myPart.UpdateObject myCircPattern3
myPart.Update
'HSF.GSMVisibility myHB, 0
Dim MyListGS As Selection
Set MyListGS = CATIA.ActiveDocument.Selection
MyListGS.Clear
MyListGS.Add myHB
MyListGS.VisProperties.SetShow catVisPropertyNoShowAttr
myPart.Update
myPart.Update
End Sub