Здравствуйте!
Компас 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
Получение обозначение из чертежа проф. Компаса:
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
Наименование можно получить аналогично, только номер ячейки будет другой.