Работа со штампом чертежа

Автор А8208, 20.12.11, 16:16:27

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

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

А8208

Здравствуйте!
Компас V12. среда-VB
Имеется необходимость получить обозначение и наименование из чертежа детали.
Всё сделал как написано в SDK и не работает.
Подскажите, где ошибка?

Dim Document2D As KompasAPI7.Documents
                                Document2D = Kompas.Documents
                                Document2D.Open(coll(i), Visible:=True, [ReadOnly]:=True)
                                'Kompas.HideMessage = Kompas6Constants.ksHideMessageEnum.ksHideMessageYes
                                Dim doc As Object
                                doc = Kompas.ActiveDocument
                                'doc.SheetAutoNumber() ' включение автоматической нумерации листов чертежей
                                Dim docPar As KompasAPI7.ILayoutSheets
                                docPar = doc.LayoutSheets
                                ' Определение кол-ва листов
                                Dim Listov As Long
                                Listov = docPar.Count
                                'Цикл перебора форматов и ориентаций листов чертежа
                                Dim ii As Long
                                For ii = 1 To Listov
                                    Dim Format As Long
                                    Dim Orient As Boolean
                                    Dim naimenovanie As String
                                    Dim oboznachenie As String
                                    Format = docPar.ItemByNumber(ii).Format.Format
                                    Orient = docPar.ItemByNumber(ii).Format.VerticalOrientation
                                    naimenovanie = docPar.ItemByNumber(ii).Stamp.Text(1).Str
                                    oboznachenie = docPar.ItemByNumber(ii).Stamp.Text(2).Str

ainis

Получение обозначение из чертежа проф. Компаса:

Dim iKompas As Kompas6API5.KompasObject = Marshal.GetActiveObject("KOMPAS.Application.5")
Dim iDoc2D As Kompas6API5.ksDocument2D = iKompas.ActiveDocument2D 'активный документ Компас
Dim docPar As Kompas6API5.DocumentParam = iKompas.GetParamStruct(StructType2DEnum.ko_DocumentParam)
iDoc2D.ksGetObjParam(iDoc2D.reference, docPar)
Dim Marking As String 'искомое обозначение
Call GetMarking(iKompas, iStamp, Marking) 'получаем обозначение


Процедура получения обозначения:

Public Sub GetMarking(ByVal iKompas As Kompas6API5.KompasObject, _
                            ByVal iStamp As Kompas6API5.ksStamp, ByRef Marking As String)
      'Получить обозначение из чертежа проф. Компаса.

      Dim O As String = ""
      Marking = "" 'Обозначение
      If iKompas IsNot Nothing And iStamp IsNot Nothing Then
        Try
          iStamp.ksOpenStamp() 'открываем штамп
          Dim DynMass As Kompas6API5.ksDynamicArray = iKompas.GetDynamicArray(3) 'массив указателей на интерфейсы ksTextLineParam
          Dim DynMassText As Kompas6API5.ksDynamicArray = iKompas.GetDynamicArray(4) 'массив указателей на интерфейсы ksTextItemParam
          Dim TLine As Kompas6API5.ksTextLineParam = _
          iKompas.GetParamStruct(StructType2DEnum.ko_TextLineParam) 'Интерфейс параметров строки текста
          Dim T As Kompas6API5.ksTextItemParam = _
          iKompas.GetParamStruct(StructType2DEnum.ko_TextItemParam) 'Интерфейс параметров компоненты строки текста
          iStamp.ksColumnNumber(2) 'делаем ячейку с обозначением активной
          TLine.Init() 'обнуляем параметры
          T.Init() 'обнуляем параметры
          DynMass = iStamp.ksGetStampColumnText(2)
          If DynMass.ksGetArrayCount > 0 Then
            Dim i As Integer
            For i = 0 To DynMass.ksGetArrayCount - 1
              If DynMass.ksGetArrayItem(i, TLine) = 1 Then
                DynMassText = TLine.GetTextItemArr()
                If DynMassText.ksGetArrayCount > 0 Then
                  Dim II As Integer
                  For II = 0 To DynMassText.ksGetArrayCount - 1
                    If DynMassText.ksGetArrayItem(II, T) = 1 Then
                      If Not T.s Like "" Then O = O + " " + Trim(T.s)
                    End If
                    T.Init() 'обнуляем параметры
                  Next
                End If
                TLine.Init() 'обнуляем параметры
                T.Init() 'обнуляем параметры
                DynMassText.ksClearArray()
              End If
            Next
          End If
          TLine.Init() 'обнуляем параметры
          T.Init() 'обнуляем параметры
          DynMassText.ksDeleteArray()
          DynMass.ksDeleteArray()
          O = Trim(O)
          Marking = O
          iStamp.ksCloseStamp() 'закрываем штамп
        Catch
          Marking = ""
          iStamp.ksCloseStamp() 'закрываем штамп
         End Try
      End If
    End Sub


Наименование можно получить аналогично, только номер ячейки будет другой.