Option Explicit
' COPYRIGHT DASSAULT SYSTEMES 2005

' *****************************************************************************
'   Purpose:      This sample illustrats the use of IDL interfaces
'                 CATIAPspStretchableData
'    Assumption:  Looks for document CAAPsp3DEduIn.CATProduct
'                 Looks for object P-074. 
'                 
'   Languages:    VBScript
'   Locales:      English 
'   CATIA Level:  V5R15 
' *****************************************************************************

'--- strMessage_g is a global variable visible to all private Sub/Function

Dim strMessage_g As String


Sub CATMain()

    ' ------------------------------------------------------------------------- 
    ' Optional: allows to find the sample wherever it's installed
    dim sDocPath As String 
    dim sDocFullPath As String 
    sDocPath=CATIA.SystemService.Environ("CATDocView")

    If (Not CATIA.FileSystem.FolderExists(sDocPath)) Then
      Err.Raise 9999,sDocPath,"No Doc Path Defined"
    End If

    ' ------------------------------------------------------------------------- 
    ' Open the Distributive system document 
    Dim objPspDoc As Document

    sDocFullPath = CATIA.FileSystem.ConcatenatePaths(sDocPath, _    
       "online\CAAScdPspUseCases\samples\CAAPsp3DEduIn.CATProduct" )
    
    
    Set objPspDoc = CATIA.Documents.Open(sDocFullPath)

    strMessage_g = _
      "--------------------------------------------------------------------" & vbCr
    strMessage_g = strMessage_g & _
      "Output traces from CAAPspStretchableData.CATScript" & vbCrLf


    Dim objPrdRoot        As Product
    Dim objPspWorkbench   As PspWorkbench
    

    ' ---------------
    ' Find the top node of the Distributive System object tree - .  
    
    If ( Not ( objPspDoc Is Nothing ) ) Then
      Set objPrdRoot = objPspDoc.Product 
      'Set objPrdRoot = CATIA.ActiveDocument.Product
      If ( Not ( objPrdRoot Is Nothing ) ) Then
        Set objPspWorkbench = objPrdRoot.GetTechnologicalObject ("PspWorkbench")
      End If
    End If


    Dim objPspApplication As PspApplication
    Dim objPspAppFactory  As PspAppFactory    

    '-----------------------------------------------------------------------
    ' Get PspWorkBench, PspApplication 
    '-----------------------------------------------------------------------

    If ( objPspWorkbench Is Nothing  ) Then
      strMessage_g = strMessage_g & "Unable to get PspWorkbench" & vbCr                
    Else
      strMessage_g = strMessage_g & "Success in getting PspWorkbench" & vbCr                           
    End If
    

    If ( Not ( objPspWorkbench Is Nothing ) ) Then
      Set objPspApplication = objPspWorkbench.GetApplication(catPspIDLCATPiping)

      If ( Not( objPspApplication Is Nothing )  ) Then        
        objPspApplication.Initialization()             
      End If
    End If '--- If ( Not ( objPspWorkbench Is Nothing )...    

    '
    ' ----------------------------------------------------
    ' Get the Bendable pipe whose instance name is P-074
    ' and then get handler to PspStretchableData
    ' ----------------------------------------------------
    Dim objBendablePipe As Product
    Dim objPspStretchableData   As PspStretchableData
    
    If ( Not ( objPspWorkbench Is Nothing ) And _
         Not ( objPrdRoot Is Nothing ) ) Then
    
      Set objBendablePipe = objPrdRoot.Products.Item("P-074")                    
      Set objPspStretchableData = objPspWorkbench.GetInterface("CATIAPspStretchableData", _
                                                objBendablePipe )                  

    End If '--- If ( Not ( objPspWorkbench Is Nothing ) and objPspApplication
    
    '-----------------------------------------------------------------------
    ' Get PspStretchableData object information
    '-----------------------------------------------------------------------

    Dim objRelAxisPrd  As Product
    Dim objLDefPoints  As PspListOfDoubles
    Dim objLBendRadii  As PspListOfDoubles
    Dim intIdx         As Integer
    Dim iNbPts         As Integer

    Dim dbX            As Double
    Dim dbY            As Double
    Dim dbZ            As Double
    Dim dbRadius       As Double
    Dim iCoordNum      As Double

    Set objRelAxisPrd = Nothing
    If ( Not ( objPspStretchableData Is Nothing ) ) Then         

      strMessage_g = strMessage_g & "Success in getting PspStretchableObject" & vbCr      
      Set objLDefPoints = objPspStretchableData.ListDefinitionPoints ( _       
                            objRelAxisPrd )      

      '-----------------------------------------
      ' Display information on Definition points
      '-----------------------------------------
      If ( Not ( objLDefPoints Is Nothing ) ) Then        
        iNbPts =  objLDefPoints.Count / 3
        strMessage_g = strMessage_g & _
               "Number of definition points =" &  iNbPts & vbCr    
        For intIdx = 1 To objLDefPoints.Count Step 3                   
          dbX = objLDefPoints.Item( intIdx )
          dbY = objLDefPoints.Item( intIdx + 1 )
          dbX = objLDefPoints.Item( intIdx + 2 )
  
          strMessage_g = strMessage_g & "Definition pt " &  vbCr                                 
          strMessage_g = strMessage_g & "      X= " & dbX & vbCr                                 
          strMessage_g = strMessage_g & "      Y= " & dbY & vbCr                                 
          strMessage_g = strMessage_g & "      Z= " & dbZ & vbCr                                 
          
        Next 

      End If

           
      Set objLBendRadii = objPspStretchableData.ListBendData 

      '-----------------------------------------
      ' Display Bend radii information
      '-----------------------------------------
      If ( Not ( objLBendRadii Is Nothing ) ) Then        
        iNbPts =  objLDefPoints.Count / 3
        strMessage_g = strMessage_g & _
               "Number of bend radii =" &  objLBendRadii.Count & vbCr    
        For intIdx = 1 To objLBendRadii.Count 
          dbRadius = objLBendRadii.Item( intIdx )          
          strMessage_g = strMessage_g & _
               "   Bend radius = " & dbRadius & vbCr                                   
        Next 

      End If


    End If ' End of  If ( Not ( objPspStretchableData is Nothing...

    strMessage_g = strMessage_g & _
      "--------------------------------------------------------------------" & vbCr
    MsgBox strMessage_g

End Sub