Public part As part
Sub CATMain()
Dim partDocument As partDocument
Dim hybridBodies1 As HybridBodies
Dim TargetBody As HybridBody
Dim hybridShapes1 As HybridShapes
Set partDocument = CATIA.ActiveDocument
Set part = partDocument.part
Set hybridBodies1 = part.HybridBodies
Set TargetBody = hybridBodies1.Item("Geometrical Set.1" )
Set hybridShapes1 = TargetBody.HybridShapes
Dim CenterPoint As HybridShapePointCoord
Set CenterPoint = hybridShapes1.Item("CenterPoint" )
Dim RefPoint As Reference
Set RefPoint = part.CreateReferenceFromObject(CenterPoint)
Dim axisSystem1 As AxisSystem
Set axisSystem1 = part.AxisSystems.Item(1)
Dim RefAxisSystem As Reference
Set RefAxisSystem = part.CreateReferenceFromObject(axisSystem1)
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part.HybridShapeFactory
Dim LowerLimit As Double
Dim UpperLimit As Double
LowerLimit = CDbl(InputBox("Input the lower radius", "Lower radius" ))
UpperLimit = CDbl(InputBox("Input the upper radius", "Upper radius" ))
Dim I As Integer
Dim Step As Double
Step = (UpperLimit - LowerLimit) / (20 - 1)
Dim CurrentRadius As Double
For I = 0 To 20 - 1
CurrentRadius = LowerLimit + I * Step
CreateSphere RefPoint, RefAxisSystem, CurrentRadius, TargetBody
Next
End Sub
Sub CreateSphere(RefCenterPoint As Reference, RefAxisSystem, Radius, TargetGeometricalSet As HybridBody)
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part.HybridShapeFactory
Dim hybridShapeSphere1 As HybridShapeSphere
Set hybridShapeSphere1 = hybridShapeFactory1.AddNewSphere(RefCenterPoint, RefAxisSystem, Radius, -45#, 45#, 0#, 180#)
hybridShapeSphere1.Limitation = 1
TargetGeometricalSet.AppendHybridShape hybridShapeSphere1
hybridShapeSphere1.Name = "Sphere_" & Radius
part.UpdateObject hybridShapeSphere1
End Sub |