Получение данных из основной надписи

Автор andrew1233, 29.11.10, 09:55:09

« назад - далее »

0 Пользователи и 2 гостей просматривают эту тему.

andrew1233

Подскажите уважаемые как извлечь содержимое из 1 строки штампа пример в step 5, конечно хороший но он получает данные по всем строкам...

Dim stamp As Kompas6API5.stamp             
  Set stamp = ksDocument2D.GetStamp()   
  If Not stamp Is Nothing And stamp.ksOpenStamp() Then             
    Dim numb As Long
    Dim Arr As Object ' ksDynamicArray
    Set Arr = stamp.ksGetStampColumnText(numb)
   Do While Not Arr Is Nothing  'numb
      Kompas.ksMessage "numb = " & numb
  Dim ArrpLineText As Object ' ksDynamicArray
     Set ArrpLineText = Kompas.GetDynamicArray(TEXT_LINE_ARR)
      Dim ItemLineText As Object ' ksTextLineParam
      Set ItemLineText = Kompas.GetParamStruct(ko_TextLineParam)
      'ItemLineText.Init
      If Not ItemLineText Is Nothing And Not ArrpLineText Is Nothing And Not Arr Is Nothing Then
        Dim count As Integer
        count = Arr.ksGetArrayCount
         For i = 0 To count - 1 'iArr.ksGetArrayCount - 1
          Arr.ksGetArrayItem i, ItemLineText
          Kompas.ksMessage "номер ячейки= " & i & " ????? = " & ItemLineText.Style
          Dim ArrpTextItem As Object ' ksDynamicArray
          Set ArrpTextItem = ItemLineText.GetTextItemArr
          Dim Item As Object
         Set Item = Kompas.GetParamStruct(ko_TextItemParam)
          'Item.Init
          If Not ArrpTextItem Is Nothing And Not Item Is Nothing Then
          For j = 0 To ArrpTextItem.ksGetArrayCount - 1
              ArrpTextItem.ksGetArrayItem j, Item
              Dim TextItemFont As Object ' ksTextItemFont
              Set TextItemFont = Item.GetItemFont
              Kompas.ksMessage "компонента= " & j & " s  " & Item.s
            Next
        ArrpTextItem.ksDeleteArray
          End If
       Next
        ArrpLineText.ksDeleteArray
        Arr.ksDeleteArray
      End If
      Set Arr = stamp.ksGetStampColumnText(numb)
    Loop
      End If
    stamp.ksCloseStamp
  'Else
    Kompas.ksError "Штамп ненайден"
     'End If
    'Set ksDocument2D = Kompas.ActiveDocument2D
    'If Not ksDocument2D Is Nothing Then
    '  ksDocument2D.ksCloseDocument
    'End If

andrew1233


andrew1233

Решение вот такое, но вопрос вот в чем на VB и VBA этот код работает, а вот на VBscript не хочет может кто подскажет где я ошибаюсь..
Проблема в том что значение numb возвращается пустое и как следствие дальше по ходу исполнения данных нет...

Set stamp = ksDocument2D.GetStampEx(1) 
  If Not stamp Is Nothing And stamp.ksOpenStamp Then               
    stamp.ksColumnNumber 4
    Dim numb   
    Dim Arr()
    Set Arr = stamp.ksGetStampColumnText(numb)
MsgBox  " numb " & numb
    Dim ArrpLineText()
      Set ArrpLineText = Kompas.GetDynamicArray(3)
      Dim ItemLineText()
      Set ItemLineText = Kompas.GetParamStruct(29)
       If Not ItemLineText Is Nothing And Not ArrpLineText Is Nothing And Not Arr Is Nothing Then
        Arr.ksGetArrayItem 0, ItemLineText
MsgBox  "Style " & ItemLineText.Style
          Dim ArrpTextItem
          Set ArrpTextItem = ItemLineText.GetTextItemArr
End If
          Dim Item
          Set Item = Kompas.GetParamStruct(31)
          If Not ArrpTextItem Is Nothing And Not Item Is Nothing Then
             ArrpTextItem.ksGetArrayItem 0, Item
              Dim TextItemFont
              Set TextItemFont = Item.GetItemFont
               MsgBox "Soderzanie" & Item.s