Тема: Помогите разобраться с подшивками

Как запустить примеры работы с подшивкой, приведенные здесь:
http://www.augi.com/education/auhandout … CP15-1.pdf
При запуске первого же примера VBA выдает, что не определен пользовательский тип данных
Подскажите, PLS

Re: Помогите разобраться с подшивками

> kp
Добавь ссылку на библиотеку:
AcSmComponents17 1.0 Type Library
и будет тебе счастье
~'J'~

Re: Помогите разобраться с подшивками

> kp
Не забыл добавить в References один из двух файлов: AcSmComponents16.tlb или AcSmComponents17.tlb (в зависимости от версии AutoCAD)?

Re: Помогите разобраться с подшивками

Не бейте чайника ногами, но как его туда добавить?

Re: Помогите разобраться с подшивками

Меню Tools->References...->Browse (обычно C:\Program Files\Common Files\Autodesk Shared\AcSmComponents16.tlb или C:\Program Files\Common Files\Autodesk Shared\AcSmComponents17.tlb)

Re: Помогите разобраться с подшивками

Спасибо! Но это явно не последний вопрос в этой теме:-)

Re: Помогите разобраться с подшивками

Для своих целей решил немного модифицировать код, приведенный в последнем примере статьи, чтобы он не подсчитывал листы с номерами, содержащими, кроме цифр, другие знаки.
Моя добавка выделена звездочками ('*****)

'' Open a Sheet Set
Public Sub OpenSheetSet()
'' Create a Reference to the Sheet Set Manager Object
Dim oSheetSetMgr As AcSmSheetSetMgr
Set oSheetSetMgr = New AcSmSheetSetMgr
'' Open a Sheet Set file
Dim oSheetDb As AcSmDatabase
Set oSheetDb = oSheetSetMgr.OpenDatabase("C:\Program Files\AutoCAD 2006\Sample\Sheet Sets\Architectural\IRD Addition.dst", False)
'' Return the Sheet Set Name and Description
MsgBox "Sheet Set Name: " & oSheetDb.GetSheetSet.GetName & vbCrLf + _
"Sheet Set Description: " & oSheetDb.GetSheetSet.GetDesc
'' Close the Sheet Set
oSheetSetMgr.Close oSheetDb
End Sub
'' Step through all Open Sheet Sets
Public Sub StepThroughTheSheetSetManager()
Dim oEnumDb As IAcSmEnumDatabase
Dim oItem As IAcSmPersist
'' Create a Reference to the Sheet Set Manager Object
Dim oSheetSetMgr As AcSmSheetSetMgr
Set oSheetSetMgr = New AcSmSheetSetMgr
'' Get Loaded Databases
Set oEnumDb = oSheetSetMgr.GetDatabaseEnumerator
'' Get First Open Database
Set oItem = oEnumDb.Next
'' Step through the Databases
Do While Not oItem Is Nothing
'' Display Sheet Set File Name
MsgBox oItem.GetDatabase.GetFileName
'' Get Next Open Database
Set oItem = oEnumDb.Next
Loop
End Sub
'' Used to Lock the database (SheetSet)
Private Function LockDatabase(oSheetDb As AcSmDatabase) As Boolean
'' Check the status of the database
If oSheetDb.GetLockStatus = AcSmLockStatus_UnLocked Then
oSheetDb.LockDb oSheetDb
LockDatabase = True
Else
LockDatabase = False
End If
End Function
'
' Used to Unlock the database (SheetSet)
Private Function UnlockDatabase(oSheetDb As AcSmDatabase) As Boolean
'' Check the status of the database
If oSheetDb.GetLockStatus = AcSmLockStatus_Locked_Local Then
oSheetDb.UnlockDb oSheetDb
UnlockDatabase = True
Else
UnlockDatabase = False
End If
End Function
'' Counts up the Sheets for all the Open Sheet Sets
Public Sub SetSheetCount()
Dim nSheetCount As Integer
Dim oEnumDb As IAcSmEnumDatabase
Dim oItem As IAcSmPersist
Dim sheet_num As String
'' Create a Reference to the Sheet Set Manager Object
Dim oSheetSetMgr As AcSmSheetSetMgr
Set oSheetSetMgr = New AcSmSheetSetMgr
Set oEnumDb = oSheetSetMgr.GetDatabaseEnumerator
Set oItem = oEnumDb.Next
Dim oSheetDb As AcSmDatabase
Do While Not oItem Is Nothing
Set oSheetDb = oItem
'' Lock the Database
If LockDatabase(oSheetDb) Then
On Error Resume Next
Dim oEnum As IAcSmEnumPersist
Dim oItemSh As IAcSmPersist
'' Get the Enumerator for the objects in the Sheet Set
Set oEnum = oSheetDb.GetEnumerator
Set oItemSh = oEnum.Next
'' Step through the objects in the Sheet Set
Do While Not oItemSh Is Nothing
'' Increment the counter of the object is a Sheet
'****************************************
If oItemSh.GetTypeName = "AcSmSheet" Then
  Set sheet_num = oItemSh.GetNumber
  If Val(sheet_num) > 0 Then
   nSheetCount = nSheetCount + 1
  End If
End If
'*****************************************
'' Get next object
Set oItemSh = oEnum.Next
Loop
'' Apply the Sheet Count as a custom property
Dim cBag As AcSmCustomPropertyBag
Dim cBagVal As New AcSmCustomPropertyValue
Set cBag = oSheetDb.GetSheetSet().GetCustomPropertyBag
cBagVal.InitNew cBag
cBagVal.SetFlags CUSTOM_SHEETSET_PROP
cBagVal.SetValue CStr(nSheetCount)
cBag.SetProperty "Total Sheets", cBagVal
Set cBagVal = Nothing
'' Unlock the database
UnlockDatabase oSheetDb
'' Clear and check for next SheetSet that is open
nSheetCount = 0
Else
MsgBox "Unable to access """ & sheetdb.GetSheetSet().GetName & """ Sheet Set."
End If
Set oItem = oEnumDb.Next
Loop
End Sub

Вопрос такой: почему у объекта oItemSh нет метода GetNumber (хотя у объектов типа AcSmSheet, судя по хэлпу Акада, должен быть)?
Подскажите, PLS

Re: Помогите разобраться с подшивками

> kp
Потому что ты объявляешь oItemSh не как IAcSmSheet
Попробуй замени на этот кусок:

On Error Resume Next
Dim oEnum As IAcSmEnumPersist
Dim oItemSh As IAcSmPersist
[b]Dim oacSht As IAcSmSheet[/b]
Set oEnum = oSheetDb.GetEnumerator
Set oItemSh = oEnum.Next
'' Step through the objects in the Sheet Set
Do While Not oItemSh Is Nothing
Set oacSht = oItemSh
'' Increment the counter of the object is a Sheet
'****************************************
If oacSht.GetTypeName = "AcSmSheet" Then
  sheet_num = oacSht.GetNumber
'' Debug.Print oacSht.GetNumber
  If Val(sheet_num) > 0 Then
   nSheetCount = nSheetCount + 1
  End If
End If
'*****************************************
'' Get next object
Set oItemSh = oEnum.Next
Loop

~'J'~

Re: Помогите разобраться с подшивками

> Fatty
Респект! Все работает!
Еще один вопрос остался.
Получившаяся прога работает со ВСЕМИ загруженными подшивками. Это не всегда хорошо.
Как можно программно узнать, какая именно подшивка открыта для редактирования в текущий момент времени?
В свойствах объекта AcSmSheetSetMgr ничего похожего не нашел:-(
Подскажите, PLS

Re: Помогите разобраться с подшивками

> kp
Тоже ничего подобного не нашел, надо искать
какие-то обходные пути
Если найдешь решение, тоже было бы интересно
глянуть
~'J'~

Re: Помогите разобраться с подшивками

Здравствуйте!
Я создал вручную custom property "Марка" для листов (sheet). Как можно программно назначить всем листам значение для этого свойства, ну например "К100".
Спасибо

Re: Помогите разобраться с подшивками

Если это свойство ОДИНАКОВО для ВСЕХ листов подшивки, почему бы не назначить его самой подшивке вместо того, чтобы назначать каждому листу по отдельности?

Re: Помогите разобраться с подшивками

> kp
Нет, оно для всех листов разное

Re: Помогите разобраться с подшивками

Решил сделать автонумерацию листов в подшивке. Но почему-то нумерация получается не в порядке расположения листов в дереве подшивки, отображаемом в окне диспетчера подшивок, а в каком-то случайном (может быть, в порядке добавления листов в подшивку). Помогите разобраться, что там не так.

'' Renumbers the Sheets for all the Open Sheet Sets
Public Sub HRENUM()
Dim nSheetCount As Integer
nSheetCount = 1
Dim oEnumDb As IAcSmEnumDatabase
Dim oItem As IAcSmPersist
Dim oacSht As IAcSmSheet
Dim sheet_num As String
'' Create a Reference to the Sheet Set Manager Object
Dim oSheetSetMgr As AcSmSheetSetMgr
Set oSheetSetMgr = New AcSmSheetSetMgr
Set oEnumDb = oSheetSetMgr.GetDatabaseEnumerator
Set oItem = oEnumDb.Next
Dim oSheetDb As AcSmDatabase
Do While Not oItem Is Nothing
Set oSheetDb = oItem
'' Lock the Database
If LockDatabase(oSheetDb) Then
On Error Resume Next
Dim oEnum As IAcSmEnumPersist
Dim oItemSh As IAcSmPersist
'' Get the Enumerator for the objects in the Sheet Set
Set oEnum = oSheetDb.GetEnumerator
Set oItemSh = oEnum.Next
'' Step through the objects in the Sheet Set
Do While Not oItemSh Is Nothing
Set oacSht = oItemSh
'' Increment the counter of the object is a Sheet
If oItemSh.GetTypeName = "AcSmSheet" Then
      sheet_num = oacSht.GetNumber
    If Val(sheet_num) >= 0 And Not sheet_num Like "*С*" Then
       oacSht.SetNumber Str(nSheetCount)
       nSheetCount = nSheetCount + 1
    End If
End If
'' Get next object
Set oItemSh = oEnum.Next
Loop
'' Unlock the database
UnlockDatabase oSheetDb
'' Clear and check for next SheetSet that is open
nSheetCount = 1
Else
MsgBox "Unable to access """ & sheetdb.GetSheetSet().GetName & """ Sheet Set."
End If
Set oItem = oEnumDb.Next
Loop
End Sub

Re: Помогите разобраться с подшивками

Вернее, я догадываюсь, что не так - итератор подшивки просматривает листы в том порядке, в котором они там есть, т.е. в порядке добавления их в подшивку. Получается, где-то еще должна храниться инфа о сортировке листов, которая используется Диспетчером подшивок и функцией вставки ведомости листов. Но где еЁ взять - кто бы подсказал...

Re: Помогите разобраться с подшивками

> kp
Посмотри свойство TabOrder в Help
~'J'~

Re: Помогите разобраться с подшивками

> fixo
TabOrder - это свойство листа, которое никак не зависит от подшивки и определяет его положение среди вкладок :(

Re: Помогите разобраться с подшивками

> kp
Просто ты спросил:

где-то еще должна храниться инфа о сортировке листов

Так оно и есть то самое
~'J'~

Re: Помогите разобраться с подшивками

Дык я о сортировке листов В ПОДШИВКЕ! TabOrder тут ничего не решает! :(
Судя по всему, нужная мне инфа хранится в AcSmDSTFiler. Но этот объект "был создан для служебного пользования и толком не тестирован". В нем тоже есть метод GetDatabase. Но что делать дальше - не знаю:(

Re: Помогите разобраться с подшивками

> kp
Упсссс, извини, оплошал, невнимателен стал :(
Тогда я пас...
~'J'~

Re: Помогите разобраться с подшивками

Снова вернулся я к старой теме.
Подскажите, как можно из объектов подшивки, имеющих хитронавороченные типы, извлечь что-то полезное?
В частности, меня интересуют:
- IAcSmCustomPropertyValue (значение пользовательского свойства). Вроде бы должна быть просто строка, ан нет. Как преобразовать это чудо в String?
- IAcSmCustomPropertyValue (меня инетерсует в виде, возвращаемом методом AcSmSheet.GetLayout и содержащем имя файла и листа, на которые ссылается лист подшивки). Опять же, как преобразовать это дело в какой нибудь массив строк?
Подскажите, PLS

Re: Помогите разобраться с подшивками

с IAcSmCustomPropertyValue немного разобрался. Метод GetValue рулит:-)
Дальше стоит задача передать массивы Prop_name_list и Prop_val_list в LISP-прогу. Не спрашивайте, почему нельзя все до конца сделать на VBA, он мне и так надоел:-).
Нашел в закромах этой ветки примеры работы со словарями, но что-то не получается. Записи в словаре создаются, но остаются пустыми:-(
Работающий пример из хелпа видел, но как его применить - не знаю:-(.
Код, работающий со словарем, выделен жирным. Помогите, PLS

Public Sub gss()
Dim oEnumDb As IAcSmEnumDatabase
Dim oItem As IAcSmPersist
Dim oacSht As IAcSmSheet
Dim sheet_num As String
'' Create a Reference to the Sheet Set Manager Object
Dim oSheetSetMgr As AcSmSheetSetMgr
Set oSheetSetMgr = New AcSmSheetSetMgr
Set oEnumDb = oSheetSetMgr.GetDatabaseEnumerator
Set oItem = oEnumDb.Next
Dim oSheetDb As AcSmDatabase
Do While Not oItem Is Nothing
Set oSheetDb = oItem
'' Lock the Database
If LockDatabase(oSheetDb) Then
On Error Resume Next
Dim oEnum As IAcSmEnumPersist
Dim oItemSh As IAcSmPersist
Dim cBag As AcSmCustomPropertyBag
Set cBag = oSheetDb.GetSheetSet().GetCustomPropertyBag
Dim cBagEnum As IAcSmEnumProperty
Set cBagEnum = cBag.GetPropertyEnumerator
Dim propname As String
Dim ppValue As IAcSmCustomPropertyValue
cBagEnum.Next propname, ppValue
Dim nPropCount As Integer
nPropCount = 0
Do While Not ppValue Is Nothing
    cBagEnum.Next propname, ppValue
    If propname Like "СМ#" Then nPropCount = nPropCount + 1
Loop
Dim Prop_name_list() As String
Dim Prop_val_list() As String
ReDim Prop_name_list(nPropCount)
ReDim Prop_val_list(nPropCount)
Dim i As Integer
i = 0
cBagEnum.Reset
cBagEnum.Next propname, ppValue
Do While Not ppValue Is Nothing
    cBagEnum.Next propname, ppValue
    If propname Like "СМ#" Then
        nPropCount = nPropCount + 1
        Prop_name_list(i) = propname
        Prop_val_list(i) = CStr(ppValue.GetValue)
        i = i + 1
    End If
Loop
[b]Dim kp_sm_Dict As AcadDictionary
Set kp_sm_Dict = ActiveDocument.Dictionaries.Add("kp_sm_Dict")
Dim kp_sm_xrec_propname As AcadXRecord, kp_sm_xrec_propval As AcadXRecord
Dim XRecordDataType As Variant
XRecordDataType = vbArray
ReDim Preserve XRecordDataType(0 To nPropCount + 1)
Set kp_sm_xrec_propname = kp_sm_Dict.AddXRecord("kp_sm_xrec_propname")
Set kp_sm_xrec_propval = kp_sm_Dict.AddXRecord("kp_sm_xrec_propval")
kp_sm_xrec_propname.SetXRecordData vbArray, Prop_name_list
kp_sm_xrec_propval.SetXRecordData vbArray, Prop_val_list
'пробуем прочитать, а там пусто:-(
Dim XRecordDataType1 As Variant, XRecordData As Variant
kp_sm_xrec_propname.GetXRecordData XRecordDataType1, XRecordData[/b]
Set cBagVal = Nothing
'' Unlock the database
UnlockDatabase oSheetDb
'' Clear and check for next SheetSet that is open
'nSheetCount = 0
Else
MsgBox "Unable to access """ & sheetdb.GetSheetSet().GetName & """ Sheet Set."
End If
Set oItem = oEnumDb.Next
Loop
End Sub

Re: Помогите разобраться с подшивками

Насчет VBA не подскажу, а решение (текст кода и скомпилированную dll-ку) я выложил тут:
https://www.caduser.ru/forum/topic45436.html
сразу предупреждаю - написан для 2009-й версии автокада.