Automatically Create Cross-ties for a Roller Coaster Using VBA CATScript

Are you looking for a way to pattern an object multiple times in CATIA? How do you write catscripts in CATIA? Are you looking for a CAD model roller coaster? You've come to the write place.

If you been following this blog then you're probably aware of my work on the cantilevered roller coaster concept model. I recently created a new track to simulate the motion capability of the vehicle. I needed a quick and easy way to create all of the cross-ties which hold the two running rails together in order to create a CAD model which is as realistic as possible. At first, I was using patterns for each section of track: rectangular pattern for straight sections and circular patterns for turns and hills. This was a very time consuming process. My model contains two track that are currently around a thousand feet long. With a little bit of help from a CATIA forum, I was able to put together a CATScript which quickly and easily creates all of the cross-ties at once.

In order to get this work there are a few things that needed to be done. The rails had to be in their own separate part file. There had to be a geometrical set named "Rollercoaster." You have to select the guide curves for each rail before running the VBA code.

Here is the procedure used in the CATScript:

1. Place point1 on guidecurve1 and point2 on guidecurve2 each at equal distance from their start points.
2. Create plane normal to guidecurve1 through point1.
3. Find an intersection between normal plane and guidecurve2
4. Use near operation to select element from intersection that lie on guidecurve2 (in case if there are multiple intersections). Use point2 as reference element. Then redefine point2 to point found.
5. Place a tangent line to guidecurve1 at point1 using AddNewLineTangency method with length limits -1.5'' and 1.5'' (tangentline1)
6. Place a tangent line to guidecurve2 at point2 using AddNewLineTangency method with length limits -1.5'' and 1.5'' (tangentline2)
7. Look for points at ends of tangentline1 with AddNewPointOnCurveFromPercent method using 0% and 100% values.
8. Look for points at ends of tangentline2 with AddNewPointOnCurveFromPercent method using 0% and 100% values.
9. Connect points from 3 and 4 with lines using AddNewLinePtPt method.
10. Create new fill object using AddNewFill method and add tangent lines and lines from 5 to it using it's AddBound method.
11. Create a pad using AddNewPad method of ShapeFactory object of root part of active document.

Pictured is the track before and after the macro is ran. Here is the complete code:

Automatically Create Cross-ties for a Roller Coaster
Option Explicit

Private Const ONE_FOOT_MM = 30  ' define number of millimiteres in one foot

Private Const STEP_LENGTH = 48  ' length between cross-ties, in feet
Private Const PAD_SIDE = 3      ' length of single cross-tie side, in feet


Sub CATMain()

    ' accessing part object
    Dim RootPart As Part
    Set RootPart = CATIA.ActiveDocument.Part
   
    ' retrieving target geometrical set named "Rollercoaster"
    Dim TargetGeoSet As HybridBody
    Set TargetGeoSet = RootPart.HybridBodies.Item("Rollercoaster")
   
    ' define partbody as work object
    Dim PartBody As Body
    Set PartBody = RootPart.MainBody
   
    RootPart.InWorkObject = PartBody

    ' accessing selection object for current document
    Dim objSelection As Selection
    Set objSelection = CATIA.ActiveDocument.Selection
   
    ' retrieving reference for first curve
    Dim GuideCurve1 As AnyObject
    Set GuideCurve1 = objSelection.Item2(1).Value

    Dim refCurve1 As Reference
    If (TypeName(GuideCurve1) = "CATIAReference") Or (TypeName(GuideCurve1) = "MonoDimFeatEdge") Then
        Set refCurve1 = GuideCurve1
    Else
        Set refCurve1 = RootPart.CreateReferenceFromObject(GuideCurve1)
    End If
   
    ' retrieving reference for second curve
    Dim GuideCurve2 As Object
    Set GuideCurve2 = objSelection.Item2(2).Value

    Dim refCurve2 As Reference
    If (TypeName(GuideCurve2) = "CATIAReference") Or (TypeName(GuideCurve2) = "MonoDimFeatEdge") Then
        Set refCurve2 = GuideCurve2
    Else
        Set refCurve2 = RootPart.CreateReferenceFromObject(GuideCurve2)
    End If
   
    ' Retrieving guides' lengths
    Dim PartProd As Product
    Set PartProd = CATIA.ActiveDocument.Product
   
    Dim SPAWbench As SPAWorkbench
    Set SPAWbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
   
    Dim objMeasurable As Measurable
    Set objMeasurable = SPAWbench.GetMeasurable(refCurve1)
   
    Dim GuideLength1 As Double
    GuideLength1 = SPAWbench.GetMeasurable(refCurve1).Length
   
    Dim GuideLength2 As Double
    GuideLength2 = SPAWbench.GetMeasurable(refCurve2).Length
   
    ' Equidistance points
    Dim PointOnCurve1 As HybridShapePointOnCurve
    Dim PointOnCurve2 As HybridShapePointOnCurve
    Dim refPOC1 As Reference
    Dim refPOC2 As Reference
   
    ' Normal plane
    Dim NormalPlane As HybridShapePlaneNormal
    Dim refNPlane As Reference
   
    Dim objIntersection As HybridShapeIntersection
    Dim refIntersection As Reference
   
    Dim objNear As HybridShapeNear
    Dim refNear As Reference
   
    ' Tangent lines
    Dim TangentLine1 As HybridShapeLineTangency
    Dim TangentLine2 As HybridShapeLineTangency
    Dim refTLine1 As Reference
    Dim refTLine2 As Reference
   
    ' endpoints for tangetnt lines
    Dim TLine1EndPoint1 As HybridShapePointOnCurve
    Dim TLine1EndPoint2 As HybridShapePointOnCurve
    Dim TLine2EndPoint1 As HybridShapePointOnCurve
    Dim TLine2EndPoint2 As HybridShapePointOnCurve
    Dim refTL1EPoint1 As Reference
    Dim refTL1EPoint2 As Reference
    Dim refTL2EPoint1 As Reference
    Dim refTL2EPoint2 As Reference
   
   
    ' lines, that connect endpoints of tangent lines
    Dim BoundLine1 As HybridShapeLinePtPt
    Dim BoundLine2 As HybridShapeLinePtPt
    Dim refBLine1 As Reference
    Dim refBLine2 As Reference
   
    ' fill object
    Dim objFill As HybridShapeFill
    Dim refFill As Reference
   
    ' direction line
    Dim DirectionLine As Line
    Dim refDLine As Reference
   
    ' pad object
    Dim objPad As Pad
    Dim refPad As Pad
   
   
   
    ' construction parameters
    Dim StepLength As Double
    StepLength = STEP_LENGTH * ONE_FOOT_MM
   
    Dim PadSideLength As Double
    PadSideLength = PAD_SIDE * ONE_FOOT_MM
   
    Dim curDistance As Double
    curDistance = StepLength
   
    ' accessing factory for creating shape objects
    Dim objHSF As HybridShapeFactory
    Set objHSF = RootPart.HybridShapeFactory
   
    ' accessing factory for creating solid objects
    Dim objHF As ShapeFactory
    Set objHF = RootPart.ShapeFactory

    ' define correct direction for second curve
    Dim SecondCurveDirection As Boolean
   
    Dim NormalDirectionDistance As Double
    Dim InvertDirectionDistance As Double
   
   
    ' get distance for normal direction
    Set PointOnCurve1 = objHSF.AddNewPointOnCurveFromDistance(refCurve1, 0, True)
    Set PointOnCurve2 = objHSF.AddNewPointOnCurveFromDistance(refCurve2, 0, True)
    Set refPOC1 = RootPart.CreateReferenceFromObject(PointOnCurve1)
    Set refPOC2 = RootPart.CreateReferenceFromObject(PointOnCurve2)
   
    TargetGeoSet.AppendHybridShape PointOnCurve1
    TargetGeoSet.AppendHybridShape PointOnCurve2
   
    RootPart.Update
       
    Set objMeasurable = SPAWbench.GetMeasurable(refPOC1)
    NormalDirectionDistance = objMeasurable.GetMinimumDistance(refPOC2)
   
    objSelection.Clear
    objSelection.Add PointOnCurve2
    objSelection.Delete
   
    ' get distance for invert direction
    Set PointOnCurve2 = objHSF.AddNewPointOnCurveFromDistance(refCurve2, 0, False)
    Set refPOC2 = RootPart.CreateReferenceFromObject(PointOnCurve2)
   
    TargetGeoSet.AppendHybridShape PointOnCurve2
   
    RootPart.Update
       
    InvertDirectionDistance = objMeasurable.GetMinimumDistance(refPOC2)
   
    If (NormalDirectionDistance < InvertDirectionDistance) Then
        SecondCurveDirection = True
    Else
        SecondCurveDirection = False
    End If
   
    objSelection.Clear
    objSelection.Add PointOnCurve1
    objSelection.Add PointOnCurve2
    objSelection.Delete
       
    ' start constructing pads
    Do While (curDistance < GuideLength1)
   
        ' place point on first curve at specified distance
        Set PointOnCurve1 = objHSF.AddNewPointOnCurveFromDistance(refCurve1, curDistance, True)
        Set refPOC1 = RootPart.CreateReferenceFromObject(PointOnCurve1)
       
        ' create plane normal to first curve at initially created point
        Set NormalPlane = objHSF.AddNewPlaneNormal(refCurve1, refPOC1)
        Set refNPlane = RootPart.CreateReferenceFromObject(NormalPlane)
       
        ' define second point as intersection of normal plane and second curve
        Set objIntersection = objHSF.AddNewIntersection(refNPlane, refCurve2)
        Set refIntersection = RootPart.CreateReferenceFromObject(objIntersection)
       
        Set PointOnCurve2 = objHSF.AddNewPointOnCurveFromDistance(refCurve2, curDistance, SecondCurveDirection)
        Set refPOC2 = RootPart.CreateReferenceFromObject(PointOnCurve2)
       
        Set objNear = objHSF.AddNewNear(refIntersection, refPOC2)
        Set refNear = RootPart.CreateReferenceFromObject(objNear)
       
        Set refPOC2 = refNear
        'Set refPOC2 = RootPart.CreateReferenceFromObject(objIntersection)
       
        ' construct tangent lines
        Set TangentLine1 = objHSF.AddNewLineTangency(refCurve1, refPOC1, (-1) * PadSideLength / 2, PadSideLength / 2, True)
        Set TangentLine2 = objHSF.AddNewLineTangency(refCurve2, refPOC2, (-1) * PadSideLength / 2, PadSideLength / 2, True)
       
        TargetGeoSet.AppendHybridShape TangentLine1
        TargetGeoSet.AppendHybridShape TangentLine2
       
        ' get reference objects for tangent lines
        Set refTLine1 = RootPart.CreateReferenceFromObject(TangentLine1)
        Set refTLine2 = RootPart.CreateReferenceFromObject(TangentLine2)
       
        ' Get endpoints for tangent lines
        Set TLine1EndPoint1 = objHSF.AddNewPointOnCurveFromPercent(refTLine1, 0, True)
        Set TLine1EndPoint2 = objHSF.AddNewPointOnCurveFromPercent(refTLine1, 1, True)
       
        Set TLine2EndPoint1 = objHSF.AddNewPointOnCurveFromPercent(refTLine2, 0, SecondCurveDirection)
        Set TLine2EndPoint2 = objHSF.AddNewPointOnCurveFromPercent(refTLine2, 1, SecondCurveDirection)
       
        TargetGeoSet.AppendHybridShape TLine1EndPoint1
        TargetGeoSet.AppendHybridShape TLine1EndPoint2
        TargetGeoSet.AppendHybridShape TLine2EndPoint1
        TargetGeoSet.AppendHybridShape TLine2EndPoint2
       
        ' get reference objects for endpoints
        Set refTL1EPoint1 = RootPart.CreateReferenceFromObject(TLine1EndPoint1)
        Set refTL1EPoint2 = RootPart.CreateReferenceFromObject(TLine1EndPoint2)
        Set refTL2EPoint1 = RootPart.CreateReferenceFromObject(TLine2EndPoint1)
        Set refTL2EPoint2 = RootPart.CreateReferenceFromObject(TLine2EndPoint2)
       
        ' construct bound lines
        Set BoundLine1 = objHSF.AddNewLinePtPt(refTL1EPoint1, refTL2EPoint1)
        Set BoundLine2 = objHSF.AddNewLinePtPt(refTL1EPoint2, refTL2EPoint2)
       
        TargetGeoSet.AppendHybridShape BoundLine1
        TargetGeoSet.AppendHybridShape BoundLine2
       
        Set refBLine1 = RootPart.CreateReferenceFromObject(BoundLine1)
        Set refBLine2 = RootPart.CreateReferenceFromObject(BoundLine2)
       
        ' create fill with contour
        Set objFill = objHSF.AddNewFill()
       
        objFill.AddBound refTLine1
        objFill.AddBound refBLine1
        objFill.AddBound refTLine2
        objFill.AddBound refBLine2
       
        TargetGeoSet.AppendHybridShape objFill
       
        Set refFill = RootPart.CreateReferenceFromObject(objFill)
       
        ' create direction
        Set DirectionLine = objHSF.AddNewLineNormal(refFill, refTL1EPoint1, False, -5, 5)
        Set refDLine = RootPart.CreateReferenceFromObject(DirectionLine)
       
        TargetGeoSet.AppendHybridShape DirectionLine
       
        ' create pad
        Set objPad = objHF.AddNewPadFromRef(refFill, PadSideLength / 2)
       
        ' define pad limits
        objPad.FirstLimit.Dimension.Value = PadSideLength / 2
        objPad.SecondLimit.Dimension.Value = PadSideLength / 2
       
        ' set direction
        objPad.SetDirection refDLine
       
        ' move to construction of the next pad
        curDistance = curDistance + StepLength
    Loop
   
    ' Update part to see added objects
    RootPart.Update


End Sub