Импорт существующего листа в открытую подшивку VBA?

Автор Тема: Импорт существующего листа в открытую подшивку VBA?  (Прочитано 1251 раз)

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

Тема содержит сообщение с Решением. Нажмите здесь чтобы посмотреть его.

Оффлайн DimkaCactusАвтор темы

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Добрый день.
Подскажите пожалуйста как импортировать лист из существующего dwg в открытую подшивку через ImportSheet?

Есть код взятый из инструкции (см. ниже) который пытаюсь прикрутить к своему.
Вызываю функцию, указываю переменные strTitle, strDesc, strNumber, strFileName, strLayout с ними все понятно, а вот что должно находится в "oComp As IAcSmComponent" не могу понять.
Как результат этой функции должен импортироваться существующий файл в уже открытую подшивку.

Подскажите пожалуйста.
Спасибо.

Код - Visual Basic [Выбрать]
  1. ' Импорт листа
  2. ' Import a Sheet into the Sheet Set or Subset
  3. Private Function ImportASheet(oComp As IAcSmComponent, _
  4. strTitle As String, _
  5. strDesc As String, _
  6. strNumber As String, _
  7. strFileName As String, _
  8. strLayout As String) As AcSmSheet
  9. '' Create a variable to hold a Subset and Sheet Set
  10. Dim oSubset As New AcSmSubset
  11. Dim oSheetSet As New AcSmDatabase
  12. '' Create a reference to a Layout Reference object
  13. Dim oLayoutRef As New AcSmAcDbLayoutReference
  14. oLayoutRef.InitNew oComp
  15.  
  16. Debug.Print Err.Number
  17.  
  18. '' Add a new Sheet to the Sheet Set
  19. '' Check to see if the Component is a Subset or Sheet Set
  20. If oComp.GetTypeName = "AcSmSubset" Then
  21. Set oSubset = oComp
  22. '' Create a new Sheet based on the template and location defined by the Subset
  23. oLayoutRef.SetFileName strFileName
  24. oLayoutRef.SetName strLayout
  25. Set ImportASheet = oSubset.ImportSheet(oLayoutRef)
  26. Else
  27. Set oSheetSet = oComp
  28. '' Create a new Sheet based on the template and location defined by the Sheet Set
  29. oLayoutRef.SetFileName strFileName
  30. oLayoutRef.SetName strLayout
  31. Set ImportASheet = oSheetSet.GetSheetSet().ImportSheet(oLayoutRef)
  32. End If
  33. '' Add the Name to the Sheet
  34. ImportASheet.SetName strTitle
  35. '' Add the Description to the Sheet
  36. ImportASheet.SetDesc strDesc
  37. '' Add the Title to the Sheet
  38. ImportASheet.SetTitle strTitle
  39. '' Add the Number to the SheetCP15-1: Taking a Look at the Sheet Set Object
  40. 12
  41. ImportASheet.SetNumber strNumber
  42. '' Add it as the first Sheet
  43. '' Check to see if the Component is a Subset or Sheet Set
  44. If oComp.GetTypeName = "AcSmSubset" Then
  45. '' Add the Sheet to the Subset
  46. oSubset.InsertComponent ImportASheet, Nothing
  47. Else
  48. '' Add the Sheet to the Root of the Sheet Set
  49. oSheetSet.GetSheetSet().InsertComponent ImportASheet, Nothing
  50. End If
  51. End Function
« Последнее редактирование: 27-10-2020, 15:16:55 от Александр Ривилис »

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 12493
  • Карма: 1621
  • Рыцарь ObjectARX
  • Skype: rivilis
1. А что такое 'ceotcnde.otuj листа'?
2. Если ты задаш в качестве первого аргумента что-либо кроме AcSmSubset, то лист вставится в конец.
« Последнее редактирование: 27-10-2020, 15:17:56 от Александр Ривилис »
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DimkaCactusАвтор темы

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
1. Это опечатка "Существующего листа"
2. Как раз это и есть проблема для меня не пойму что должно быть в аргументе oComp. У меня не хватает знаний VBA и документов по работе с подшивками мало.
Как результат в уже открытую подшивку в конец добавляется лист "Лист1" из существующего файла  "1.dwg"

Код - Visual Basic [Выбрать]
  1. Option Explicit
  2. Dim ОткрытаяПодшивка As String
  3. Dim osheetdb As AcSmDatabase
  4. Dim oComp As IAcSmComponent
  5. Dim sheetset As New sheetset
  6. Public Sub StepThroughTheSheetSetManager()
  7. Dim oEnumDb As IAcSmEnumDatabase
  8. Dim oItem As IAcSmPersist
  9. Dim osheetSetMgr As AcSmSheetSetMgr
  10.  Set osheetSetMgr = New AcSmSheetSetMgr
  11.  Set oEnumDb = osheetSetMgr.GetDatabaseEnumerator
  12.  Set oItem = oEnumDb.Next
  13. Do While Not oItem Is Nothing
  14. ОткрытаяПодшивка = oItem.GetDatabase.GetFileName
  15. Set oItem = oEnumDb.Next
  16. Loop
  17. Set osheetSetMgr = New AcSmSheetSetMgr
  18. Dim osheetdb As AcSmDatabase
  19. Set osheetdb = osheetSetMgr.OpenDatabase(ОткрытаяПодшивка, False)
  20. LockDatabase osheetdb
  21.  
  22. Call ImportASheet(oComp,"Титул", "Описание","номер","z:\VBA\Autocad\VBA примеры\Лист в подшивку\1.dwg", "Лист1")
  23.  
  24. UnlockDatabase osheetdb
  25. End
  26. End Sub
  27.  
  28.  

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 12493
  • Карма: 1621
  • Рыцарь ObjectARX
  • Skype: rivilis
DimkaCactus,
Настоятельно не рекомендую использовать кириллицу в именах переменных.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DimkaCactusАвтор темы

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Спасибо. Учту Ваши рекомендации. Но все же прошу помочь. Что необходимо прописать в строке 21, что  функция ImportASheet выполнила свою задачу. У меня на этом места весь проект застопорился.

Оффлайн trir

  • ADN Club
  • ****
  • Сообщений: 394
  • Карма: 53
Цитировать
и документов по работе с подшивками мало
по чему первый и очевидный запрос в гугл (IAcSmComponent autocad vba)
возврашает ссылку на статью 2013! года https://adndevblog.typepad.com/autocad/2013/09/using-sheetset-manager-api-in-vbnet.html

Код - vb.net [Выбрать]
  1. ' Open a Sheet Set
  2.  
  3. <CommandMethod("ADSK_OpenSheetSet")> _
  4.  
  5. Public Sub OpenSheetSet()
  6.  
  7.     ' Get a reference to the Sheet Set Manager object
  8.  
  9.     Dim sheetSetManager As IAcSmSheetSetMgr
  10.  
  11.     sheetSetManager = New AcSmSheetSetMgr
  12.  
  13.     ' Open a Sheet Set file
  14.  
  15.     Dim sheetSetDatabase As AcSmDatabase
  16.  
  17.     sheetSetDatabase = sheetSetManager.OpenDatabase("C:\Program Files\AutoCAD
  18.  
  19.                2010\Sample\Sheet Sets\Architectural\IRD Addition.dst", False)
  20.  
  21.     ' Return the namd and description of the sheet set
  22.  
  23.     MsgBox("Sheet Set Name: " + sheetSetDatabase.GetSheetSet().GetName() + vbCrLf + _  
  24.  
  25.            "Sheet Set Description: " + sheetSetDatabase.GetSheetSet().GetDesc())
  26.  
  27.     ' Close the sheet set
  28.  
  29.     sheetSetManager.Close(sheetSetDatabase)
  30.  
  31. End Sub
здесь sheetSetDatabase  - нужный объект, и хотя это не VBA - там примерно тоже самое

Лично у меня код работы с подшивками через COM перестал работать в последних версиях
но мне уже было пофиг - я работал напрямую с xml https://github.com/triroakenshield/AcSmSheetSetMgr

Пример в AutoCAD'е
C:\Program Files\Autodesk\AutoCAD 2020\Sample\ActiveX\SheetSetVBA\SheetSetVBA.dvb

Код - Visual Basic [Выбрать]
  1. Option Explicit
  2. Dim sheetCount As Integer
  3. Dim sheetSetMgr As IAcSmSheetSetMgr
  4. Dim sheetset As IAcSmSheetSet
  5. Dim sheetdb As IAcSmDatabase
  6. Dim eventHndlr As EventHandler
  7. Dim eventSSMCookie As Long
  8. Dim eventDbCookie As Long
  9. Dim eventSSetCookie As Long
  10. Dim dwtLayoutref As New AcSmAcDbLayoutReference 'default DWT
  11. Dim fileRef As New AcSmFileReference 'default sheet location
  12.  
  13. Function isInitialized() As Boolean
  14.     If sheetSetMgr Is Nothing Then
  15.         ThisDrawing.Utility.Prompt "Sheetset manager not initialized!!"
  16.         isInitialized = False
  17.     End If
  18.    
  19.     If sheetset Is Nothing Then
  20.         ThisDrawing.Utility.Prompt "Sheetset not initialized!!"
  21.         isInitialized = False
  22.     End If
  23.    
  24.     If sheetdb Is Nothing Then
  25.         ThisDrawing.Utility.Prompt "Sheetset database not initialized!!"
  26.         isInitialized = False
  27.     End If
  28.    
  29.     isInitialized = True
  30. End Function
  31.  
  32. Public Sub CreateSheetSet(name As String, _
  33.                          path As String, _
  34.                          desc As String, _
  35.                          Optional dwtName As String = "", _
  36.                          Optional dwtPath As String = "", _
  37.                          Optional defaultSheetLoc As String = "")
  38.    
  39.     On Error Resume Next
  40.     'Release previous db and sheet set
  41.    Set sheetdb = Nothing
  42.     Set sheetset = Nothing
  43.    
  44.     Dim fullPath As String
  45.     Dim pos As Integer
  46.    
  47.     pos = Len(path)
  48.  
  49.     'check to see if user entered '\' for path at the end of the string
  50.    'if not, append it
  51.    If InStr(pos - 1, path, "\") = pos Then
  52.         fullPath = path & name & ".dst"
  53.     Else
  54.         fullPath = path & "\" & name & ".dst"
  55.     End If
  56.      
  57.    
  58.     'Create a new database overwriting existing sheetset file
  59.     Set sheetdb = sheetSetMgr.CreateDatabase(fullPath, "", True)
  60.      
  61.      'Lock the database before doing any operation on it
  62.    Call LockDatabase
  63.    
  64.     'Get the sheet set from the database
  65.    Set sheetset = sheetdb.GetSheetSet
  66.    
  67.      'Set name and description
  68.    sheetset.SetName name
  69.     sheetset.SetDesc "This is my sheet set " & name & ".dst"
  70.    
  71.     If Len(dwtPath) > 0 Then
  72.         Set dwtLayoutref = New AcSmAcDbLayoutReference
  73.         dwtLayoutref.InitNew sheetset
  74.         dwtLayoutref.SetName dwtName
  75.         dwtLayoutref.SetFileName dwtPath + "\" + dwtName
  76.         dwtLayoutref.SetName "Sheet"
  77.        
  78.         'Set default dwg template
  79.        sheetset.SetDefDwtLayout dwtLayoutref
  80.      End If
  81.      
  82.     If Len(defaultSheetLoc) > 0 Then
  83.         Set fileRef = New AcSmFileReference
  84.         fileRef.InitNew sheetset
  85.         fileRef.SetFileName (defaultSheetLoc)
  86.        
  87.         'set default sheet location
  88.        sheetset.SetNewSheetLocation fileRef
  89.     End If
  90.      
  91.     'Unlock database
  92.    Call UnlockDatabase
  93.    
  94.     ThisDrawing.Utility.Prompt ("New sheet set " & fullPath & " created")
  95.     ThisDrawing.Application.Update
  96.                          
  97. End Sub
  98.                          
  99.                          
  100. Function AddSheet(parentCategory As IAcSmSubset, _
  101.                   sheetName As String, _
  102.                   sheetDesc As String, _
  103.                   Optional layoutName As String = "", _
  104.                   Optional layoutDWGPath As String = "") As IAcSmSheet
  105.                  
  106.     On Error Resume Next
  107.    
  108.     Dim newSheet As AcSmSheet
  109.    
  110.     If isInitialized = False Then
  111.         Exit Function
  112.     End If
  113.    
  114.     'Lock the database first
  115.    LockDatabase
  116.    
  117.     If parentCategory Is Nothing Then
  118.      'category to insert is the sheet set root
  119.     Set parentCategory = sheetset
  120.     End If
  121.    
  122.     If layoutName = "" Then
  123.       If sheetset.GetDefDwtLayout Is Nothing Or sheetset.GetNewSheetLocation Is Nothing Then
  124.         ThisDrawing.Utility.Prompt "Cannot add sheet :" & sheetName & vbCrLf
  125.         ThisDrawing.Application.Update
  126.         Exit Function
  127.       Else
  128.         'Create a fresh sheet
  129.        Set newSheet = parentCategory.AddNewSheet(sheetName, sheetDesc)
  130.         newSheet.SetTitle sheetName
  131.         ' Now insert the sheet
  132.        parentCategory.InsertComponent newSheet, Nothing
  133.       End If
  134.     Else
  135.         'Create a sheet based on a layout
  136.        Dim layoutRef As New AcSmAcDbLayoutReference
  137.        
  138.         layoutRef.InitNew sheetset
  139.        
  140.         'Set layout name and file name
  141.        layoutRef.SetName layoutName
  142.         layoutRef.SetFileName layoutDWGPath
  143.        
  144.         'Import a sheet based on a layout into the category
  145.        Set newSheet = parentCategory.ImportSheet(layoutRef)
  146.        
  147.         'Now insert the sheet
  148.        parentCategory.InsertComponent newSheet, Nothing
  149.      
  150.     End If
  151.    
  152.     'Increment sheet number
  153.    sheetCount = sheetCount + 1
  154.    
  155.     'Give the new sheet a number based on sheet count
  156.    newSheet.SetNumber sheetCount
  157.    
  158.     'Unlock database
  159.    UnlockDatabase
  160.    
  161.     'retrun new sheet
  162.   Set AddSheet = newSheet
  163.    
  164. End Function
  165.  
  166. Public Sub LockDatabase()
  167.     On Error Resume Next
  168.     If isInitialized = False Then
  169.         Exit Sub
  170.     End If
  171.     Dim lockStatus As AcSmLockStatus
  172.     Let lockStatus = sheetdb.GetLockStatus
  173.  
  174.     If lockStatus = AcSmLockStatus_UnLocked Then
  175.       sheetdb.LockDb sheetdb
  176.     End If
  177.    
  178. End Sub
  179.  
  180. Public Sub UnlockDatabase()
  181.     On Error Resume Next
  182.     If isInitialized = False Then
  183.         Exit Sub
  184.     End If
  185.     Dim lockStatus As AcSmLockStatus
  186.     If lockStatus = AcSmLockStatus_Locked_Local Or AcSmLockStatus_Locked_Remote Then
  187.       sheetdb.UnlockDb sheetdb
  188.     End If
  189. End Sub
  190.  
  191. Function AddSheetCategory(name As String, _
  192.                           desc As String, _
  193.                           parentCat As IAcSmSubset) As IAcSmSubset
  194.                            
  195.     On Error Resume Next
  196.    
  197.     If isInitialized = False Then
  198.         Exit Function
  199.     End If
  200.    
  201.     Dim newCat As AcSmSubset
  202.    
  203.     If parentCat Is Nothing Then
  204.      'parent category is the sheet set root
  205.     Set parentCat = sheetset
  206.     End If
  207.    
  208.     'Lock database before we add a category
  209.    LockDatabase
  210.     Set newCat = parentCat.CreateSubset(name, desc)
  211.     'Unlock database
  212.    UnlockDatabase
  213.    
  214.     'return the newly created category
  215.    Set AddSheetCategory = newCat
  216.    
  217. End Function
  218. ' List all sheets and categories at the command line
  219. Public Sub List(db As IAcSmDatabase)
  220.    
  221.     On Error Resume Next
  222.    
  223.     Dim iter As IAcSmEnumPersist
  224.     Dim Item As IAcSmPersist
  225.     Dim sheet As IAcSmSheet
  226.     Dim subset As IAcSmSubset
  227.     Dim cpbag As AcSmCustomPropertyBag
  228.     Dim name As String
  229.     Dim desc As String
  230.     Dim value As String
  231.    
  232.     Set iter = db.GetEnumerator
  233.     Set Item = iter.Next
  234.    
  235.     Do While Not Item Is Nothing
  236.         Set sheet = Item
  237.         Set subset = Item
  238.         Set cpbag = Item
  239.        
  240.         'If Not subset Is Nothing Then
  241.        If Item.GetTypeName = "AcSmSubset" Then
  242.             'list the category (subset)
  243.            name = subset.GetName
  244.             desc = subset.GetDesc
  245.             ThisDrawing.Utility.Prompt ("-------------------------------" & vbCrLf)
  246.             ThisDrawing.Utility.Prompt ("SubSet Name :" & name & vbCrLf)
  247.             ThisDrawing.Utility.Prompt ("SubSet Desc :" & desc & vbCrLf)
  248.             ThisDrawing.Utility.Prompt ("-------------------------------" & vbCrLf)
  249.            
  250.         'ElseIf Not sheet Is Nothing Then
  251.        ElseIf Item.GetTypeName = "AcSmSheet" Then
  252.             'list the sheet
  253.            name = sheet.GetName
  254.             desc = sheet.GetDesc
  255.             ThisDrawing.Utility.Prompt ("sheet Name :" & name & vbCrLf)
  256.             ThisDrawing.Utility.Prompt ("sheet Desc :" & desc & vbCrLf)
  257.        
  258.         ElseIf Item.GetTypeName = "AcSmCustomPropertyBag" Then
  259.        
  260.             'Iterate through custom properties
  261.             Dim propIter As IAcSmEnumProperty
  262.              Set propIter = cpbag.GetPropertyEnumerator
  263.            
  264.             Dim propName As String
  265.             Dim propval As AcSmCustomPropertyValue
  266.             Do While True
  267.                 Set propval = Nothing
  268.                 propName = ""
  269.                 propIter.Next name, propval
  270.                 If propName = "" Then Exit Do 'jump out of loop
  271.        
  272.                 If Not IsEmpty(propval) And Not IsObject(propval) Then
  273.                     ThisDrawing.Utility.Prompt ("Property  " & propName & " : " & propval.GetValue & " " & vbCrLf)
  274.                 End If
  275.             Loop
  276.             End If
  277.        
  278.         Set Item = iter.Next
  279.     Loop
  280.  
  281.     ThisDrawing.Application.Update
  282.    
  283. End Sub
  284. Public Sub AddCalloutBlock(blockname As String, _
  285.                             dwg As String)
  286.                            
  287.     On Error Resume Next
  288.     If isInitialized = False Then
  289.         Exit Sub
  290.     End If
  291.    
  292.     LockDatabase
  293.     Dim calloutBlocks As IAcSmCalloutBlocks
  294.     Dim calloutRef As New AcSmAcDbBlockRecordReference
  295.  
  296.     Set calloutBlocks = sheetset.GetCalloutBlocks
  297.  
  298.     calloutRef.InitNew sheetdb
  299.     calloutRef.SetFileName dwg
  300.     calloutRef.SetName blockname
  301.    
  302.     calloutBlocks.Add calloutRef
  303.     UnlockDatabase
  304.    
  305. End Sub
  306.  
  307. Public Sub AddLabelBlock(blockname As String, _
  308.                             dwg As String)
  309.  
  310.     On Error Resume Next
  311.    
  312.     If isInitialized = False Then
  313.         Exit Sub
  314.     End If
  315.    
  316.     LockDatabase
  317.    
  318.     Dim labelRef As New AcSmAcDbLayoutReference
  319.     labelRef.InitNew sheetdb
  320.     labelRef.SetFileName dwg
  321.     labelRef.SetName blockname
  322.    
  323.     sheetset.SetDefLabelBlk labelRef
  324.     UnlockDatabase
  325. End Sub
  326.  
  327. Public Sub AddResourceFileLocation(resource As String)
  328.     On Error Resume Next
  329.    
  330.     If isInitialized = False Then
  331.         Exit Sub
  332.     End If
  333.    
  334.     LockDatabase
  335.     Dim resources As IAcSmResources
  336.     Dim fileRef As New AcSmFileReference
  337.  
  338.     Set resources = sheetset.GetResources
  339.     fileRef.InitNew sheetdb
  340.     fileRef.SetFileName resource
  341.    
  342.     resources.Add fileRef
  343.     UnlockDatabase
  344. End Sub
  345. Function AddSheetSelectionSet(name As String, _
  346.                                desc As String) As IAcSmSheetSelSet
  347.  
  348.     On Error Resume Next
  349.    
  350.     If isInitialized = False Then
  351.         Exit Function
  352.     End If
  353.    
  354.     'lock database
  355.    LockDatabase
  356.  
  357.     Dim sheetSelSets As IAcSmSheetSelSets
  358.     Dim sheetSelSet As IAcSmSheetSelSet
  359.     Set sheetSelSets = sheetset.GetSheetSelSets
  360.  
  361.     sheetSelSets.Add name, desc, sheetSelSet
  362.  
  363.     'unlock database
  364.    UnlockDatabase
  365.  
  366.     'return the selection set
  367.    Set AddSheetSelectionSet = sheetSelSet
  368.    
  369. End Function
  370.                            
  371. Public Sub AddCustomProperty(key As String, _
  372.                               value As String, _
  373.                               comp As IAcSmComponent, _
  374.                               propFlags As PropertyFlags)
  375.     On Error Resume Next
  376.    
  377.     If isInitialized = False Then
  378.         Exit Sub
  379.     End If
  380.    
  381.     LockDatabase
  382.    
  383.     Dim bag As IAcSmCustomPropertyBag
  384.     If comp Is Nothing Then
  385.         Set comp = sheetset
  386.     End If
  387.    
  388.     Set bag = comp.GetCustomPropertyBag
  389.    
  390.     Dim propval As New AcSmCustomPropertyValue
  391.     propval.InitNew bag
  392.    
  393.     propval.SetFlags propFlags
  394.     propval.SetValue value
  395.    
  396.     bag.SetProperty key, propval
  397.    
  398.     UnlockDatabase
  399. End Sub
  400. Public Sub NotifyStart()
  401.    
  402.     On Error Resume Next
  403.    
  404.     If isInitialized = False Then
  405.         Exit Sub
  406.     End If
  407.    
  408.     If Not eventHndlr Is Nothing Then
  409.         Exit Sub
  410.     End If
  411.    
  412.     Set eventHndlr = New EventHandler
  413.     'register for sheet set manager events
  414.    Let eventSSMCookie = sheetSetMgr.Register(eventHndlr)
  415.    
  416.      'register database events
  417.    Let eventDbCookie = sheetdb.Register(eventHndlr)
  418.      
  419.      'register for sheet set events
  420.    Let eventSSetCookie = sheetset.Register(eventHndlr)
  421.    
  422. End Sub
  423. Public Sub NotifyEnd()
  424.     On Error Resume Next
  425.     If isInitialized = False Then
  426.         Exit Sub
  427.     End If
  428.    
  429.     sheetSetMgr.Unregister eventSSMCookie
  430.     sheetdb.Unregister eventDbCookie
  431.     sheetset.Unregister eventSSetCookie
  432.    
  433.     Set eventHndlr = Nothing
  434. End Sub
  435. Function GetSheetSet() As IAcSmSheetSet
  436.     Set GetSheetSet = sheetset
  437. End Function
  438.  
  439. Public Sub CleanUp(error As String)
  440.     On Error Resume Next
  441.     If sheetdb Is Nothing Then
  442.         Exit Sub
  443.     End If
  444.    
  445.     ThisDrawing.Utility.Prompt error & vbCrLf
  446.    
  447.     Dim lockStat As AcSmLockStatus
  448.     Set lockStat = sheetdb.GetLockStatus
  449.     If lockStat = AcSmLockStatus_Locked_Local Or AcSmLockStatus_Locked_Remote Then
  450.         sheetdb.UnlockDb sheetdb
  451.         Set sheetdb = Nothing
  452.         Set sheetset = Nothing
  453.         Set sheetSetMgr = Nothing
  454.         Set eventHndlr = Nothing
  455.         Set dwtLayoutref = Nothing
  456.         Set fileRef = Nothing
  457.     End If
  458.  
  459. End Sub
  460.                            
  461. Private Sub Class_Initialize()
  462.     On Error Resume Next
  463.     sheetCount = 0
  464.     'Get the sheet set manager
  465.    Set sheetSetMgr = New AcSmSheetSetMgr
  466. End Sub
  467.  
  468. Private Sub Class_Terminate()
  469.  On Error Resume Next
  470.  Set sheetdb = Nothing
  471.  Set sheetset = Nothing
  472.  Set sheetSetMgr = Nothing
  473.  Set eventHndlr = Nothing
  474.  Set dwtLayoutref = Nothing
  475.  Set fileRef = Nothing
  476. End Sub

Оффлайн DimkaCactusАвтор темы

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Да. Все хорошо новые листы инициализируются и создаются. Но в ели использовать данный код в итоге через addSheet указав за основу существующий файл с инициализированным листом ( или несколькими) ты получается на  новый файл с указанным листом.
Это и отличает команду AddSheet от ImportSheet, где лист подтягивается из существующего файла без создания нового.
Моя просьба звучала немного иначе изначально:
"Как раз это и есть проблема для меня не пойму что должно быть в аргументе oComp. У меня не хватает знаний VBA и документов по работе с подшивками мало. Как результат в уже открытую подшивку в конец добавляется лист "Лист1" из существующего файла  "1.dwg" Что необходимо прописать в строке 21, что  бы функция ImportASheet выполнила свою задачу"


Оффлайн trir

  • ADN Club
  • ****
  • Сообщений: 394
  • Карма: 53
ничего не понял

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 12493
  • Карма: 1621
  • Рыцарь ObjectARX
  • Skype: rivilis
DimkaCactus,
Нужно передать SheetSet, т.е. osheetdb.GetSheetSet().
Только у тебя функция ImportASheet нерабочая. Она даже компилироваться не должна.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Отмечено как Решение Александр Ривилис 27-10-2020, 18:34:54

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 12493
  • Карма: 1621
  • Рыцарь ObjectARX
  • Skype: rivilis
Очень не люблю VBA/VB.NET:
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2.  
  3. Public Sub StepThroughTheSheetSetManager()
  4.     Dim sSheetSetName As String
  5.     Dim osheetdb As AcSmDatabase
  6.     Dim oComp As IAcSmComponent
  7.     Dim sheetset As AcSmSheetSet
  8.     Dim oEnumDb As IAcSmEnumDatabase
  9.     Dim oItem As IAcSmPersist
  10.     Dim osheetSetMgr As AcSmSheetSetMgr
  11.     Set osheetSetMgr = New AcSmSheetSetMgr
  12.     Set oEnumDb = osheetSetMgr.GetDatabaseEnumerator
  13.     Set oItem = oEnumDb.Next
  14.     Do While Not oItem Is Nothing
  15.       Set osheetdb = oItem.GetDatabase()
  16.       LockDatabase osheetdb
  17.       Set sheetset = osheetdb.GetSheetSet()
  18.       ' Номер должен быть числом
  19.      Call ImportASheet(osheetdb, "Заголовок", "Описание", "999", "C:\TEMP\Test_1.dwg", "Layout1")
  20.       UnlockDatabase osheetdb
  21.       Set oItem = oEnumDb.Next
  22.     Loop
  23. End Sub
  24. Public Function ImportASheet( _
  25.         oComp As IAcSmComponent, _
  26.         strTitle As String, _
  27.         strDesc As String, _
  28.         strNumber As String, _
  29.         strFileName As String, _
  30.         strLayout As String) As AcSmSheet
  31.                          
  32.     Dim oSheet As New AcSmSheet
  33.     'Create a variable to hold a SheetSet
  34.    Dim oSheetset As New AcSmDatabase
  35.    
  36.     'Create a reference to a Layout Reference Object
  37.    Dim oLayoutRef As New AcSmAcDbLayoutReference
  38.     oLayoutRef.InitNew oComp
  39.    
  40.     'Add a new sheet to the sheet set
  41.    Set oSheetset = oComp
  42.     oLayoutRef.SetFileName strFileName
  43.     oLayoutRef.SetName strLayout
  44.    
  45.     Set ImportASheet = oSheetset.GetSheetSet().ImportSheet(oLayoutRef)
  46.     ImportASheet.SetName strTitle
  47.     ImportASheet.SetTitle strTitle
  48.     ImportASheet.SetDesc strDesc
  49.     ImportASheet.SetNumber strNumber
  50.     ' Добавляем в конец
  51.    oSheetset.GetSheetSet.InsertComponentAfter ImportASheet, Nothing
  52.     ' А так добавляется в начало
  53.    ' oSheetset.GetSheetSet.InsertComponent ImportASheet, Nothing
  54. End Function
  55.  
  56.  
  57. Public Function LockDatabase(sheetdb As AcSmDatabase)
  58.     On Error Resume Next
  59.     Dim lockStatus As AcSmLockStatus
  60.     Let lockStatus = sheetdb.GetLockStatus
  61.  
  62.     If lockStatus = AcSmLockStatus_UnLocked Then
  63.       sheetdb.LockDb sheetdb
  64.     End If
  65.    
  66. End Function
  67.  
  68. Public Function UnlockDatabase(sheetdb As AcSmDatabase)
  69.     On Error Resume Next
  70.     Dim lockStatus As AcSmLockStatus
  71.     If lockStatus = AcSmLockStatus_Locked_Local Or AcSmLockStatus_Locked_Remote Then
  72.       sheetdb.UnlockDb sheetdb
  73.     End If
  74. End Function
  75.  





Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DimkaCactusАвтор темы

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
УРА!!!!!! Спасибо громадное за помощь!!!! ))))) Буду дальше допиливать проект. )))

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 12493
  • Карма: 1621
  • Рыцарь ObjectARX
  • Skype: rivilis
УРА!!!!!! Спасибо громадное за помощь!!!! ))))) Буду дальше допиливать проект. )))
Если сработало как надо, отмечай мой пост как Решение.
P.S.: Отмечать нужно тот пост, в котором дано решение проблемы, а не просто последний пост... ;)
« Последнее редактирование: 27-10-2020, 18:36:08 от Александр Ривилис »
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение