SheetSet Manager
Accepted solution
I took a look at the function and see where the API might be hanging up, but will have to do some research or have software development look at it closer.
If what you are interested in is knowing which sheet set a drawing and layout is associated, you can get the value by checking the Sheet Set hint stored in the drawing. The hint is stored in a dictionary named "AcSheetSetData". The AcSheetSetData dictionary contains the following values:
- Sheet Set Filename ("ShSetFileName")
- Sheet Set Version ("ShSetVersion")
- Drawing Filename ("SheetDwgName")
- Layout Name ("layoutName")
- Layout Handle ("LayoutHandle")
- Update Count ("UpdateCount")
- Last Updated Time ("UpdateTime")
To access the dictionary and its records, you could do something based on the following sample code:
Sub GetSheetSetHint()
On Error Resume Next
Dim ssDict As AcadDictionary
Set ssDict = ThisDrawing.Dictionaries("AcSheetSetData")
If Err.Number <> 0 Then
MsgBox "Dictionary not found"
End
End If
Dim ssXrec As AcadXRecord
Dim xRecVal, xRecType
For Each ssXrec In ssDict
ssXrec.GetXRecordData xRecType, xRecVal
For nXrec = 0 To UBound(xRecType)
MsgBox "Record: " + ssXrec.Name & vbLf & _
"Value: " + CStr(xRecVal(nXrec))
Next
Next ssXrec
End Sub
Hope this helps.
Lee Ambrosius
Senior Principal Content Experience Designer
For additional help, check out the AutoCAD Developer Documentation
The link to the method doesn't seem to work, so I am not sure which method at the moment you are referring to. I did an AU session on the Sheet Set API several years ago, it might be helpful in trying to figure out what you are doing.
Here is a link to the posted handout, there are code samples in the handout and available for download:
https://www.autodesk.com/autodesk-university/class/Harnessing-Power-AutoCAD-COM-APIs-2015#handout
Let me know if you don't get it figured out and what method you are referring to.
Lee Ambrosius
Senior Principal Content Experience Designer
For additional help, check out the AutoCAD Developer Documentation
Accepted solution
While I'm not familiar with this ssm method, you can improve your troubleshooting odds by using a structured error handler. It's a misconception that On Error Resume Next only applies to the following line. It stays in effect until you issue On Error GoTo 0. Thus, you didn't need to use it twice. It also, masks valid errors, making them unhandled and crashing your app without warning. Notice the commented out section of the err handler. The first time running this where an error occurs, the logic will fall through to the Case Else and display the error in the MsgBox. Use this to modify the first select case and add the logic to properly handle the error. Run it again and handle any other errors that show up. This will at least tell you why acad is crashing.
Public Sub Test()
On Error GoTo Err_Control
Dim ssm As New AcSmSheetSetMgr Dim db As New AcSmDatabase Dim str1 As String str1 = "H:\2018\Sheet set\Sheet Design 2.dst" Set db = ssm.OpenDatabase(str1) Dim dbEnum As IAcSmEnumPersist Set dbEnum = db.GetEnumerator Dim item As IAcSmPersist Set item = dbEnum.Next Dim shEnum As IAcSmEnumComponent Dim csPr As AcSmSheetSet Dim shValue As IAcSmComponent Dim objs() As Object Dim retObjs As Object
'On Error Resume Next
While Not item Is Nothing If item.GetTypeName = "AcSmSheetSet" Then Set csPr = item Set shEnum = csPr.GetSheetEnumerator Set shValue = shEnum.Next While Not shValue Is Nothing 'On Error Resume Next Set retObjs = shValue.GetDirectlyOwnedObjects(objs) Set shValue = shEnum.Next Wend End If Set item = dbEnum.Next Wend
Exit_Here:
Exit Sub
Err_Control:
Select Case Err.Number
'Add your Case selections here
'Case Is = 1000
'Handle error
'Err.Clear
'Resume Exit_Here
Case Else
MsgBox Err.Number & ", " & Err.Description, , "Test"
Err.Clear
Resume Exit_Here
End Select End Sub
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
Also, notice that the Title of the MsgBox is the same as the containing method/function. This will tell you exactly where the error is being generated, for when you have multiple methods with error handlers.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
I am still getting the same error.
I suspect it has to do with these lines
Dim objs() As Object Dim retObjs As Object
If I comment those two lines out then it does not crash but throws this error
That tells me that I am doing something wrong with the way objs is declared. The help for that method only says
Syntax GetDirectlyOwnedObjects(objects As Object()) As Object objects Output SAFEARRAY of the IUnknown pointers of the directly owned objects
I would try declaring objs as a variant, not an array(). You can't directly assign to an array, you have to assign to each element of the array. So if you use a variant, the GetDirectlyOwnedObjects function can assign anything it wants to the variable. You're also calling it wrong. According to the syntax you showed, objs is the output from the GetDirectlyOwnedObjects function. You're supposed to be supplying a variable for the function to set as an argument. The call should look something like:
Dim retObjs As Variant shValue.GetDirectlyOwnedObjects retObjs MsgBox "There are " & UBound(retObjs) & " sheets."
So you don't need to declare two variables.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
@Ed__Jobe wrote:
............The call should look something like:
Dim retObjs As Variant shValue.GetDirectlyOwnedObjects retObjs MsgBox "There are " & UBound(retObjs) & " sheets.".............
I tried doing that. This is what I get now
Try declaring retObjs() As Object. At least this time you're not trying to set another variable to an instance of the array. Also, I see that Resume Next crept back in. Get rid of that. You don't need it with the error handling I gave you. When you find out the error number that results from calling this function, you can add a Select Case for it and a line lable at the point before you call the function. For example, note the line lable GetObjs:
GetObjs: shValue.GetDirectlyOwnedObjects retObjs
...
Select ...
Case = 12345
'add logic to handle error
'clear the err object
'go back to where the error occurred and try again.
Resume GetObjs
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
Still the same error.
Accepted solution
You didn't declare it as an array. Note the parens. Also reread my prev post. I edited it before you posted your last reply.
Dim retObjs() As Object
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
Thanks for that correction. However, now I am back to the original error
Accepted solution
I haven't spent much time on looking at why the method causes a fatal error with VBA specifically, but I think its problem is rooted in the return of an array of IUnknown and possibly it shouldn't have been exposed. With that said, you should most likely use the GetSheetEnumerator method of the AcSmSubset object.
The following code iterates through the sheet set to locate the subsets and then iterates the Subsets and displays the name of each sheet in the subset:
Public Sub SSO_Step()
' Get a reference to the Sheet Set Manager object
Dim sheetSetManager As IAcSmSheetSetMgr
Set sheetSetManager = New AcSmSheetSetMgr
' Open a Sheet Set file
Dim sheetSetDatabase As AcSmDatabase
Set sheetSetDatabase = sheetSetManager.OpenDatabase("H:\2018\Sheet set\Sheet Design 2.dst", False)
' Return the name and description of the sheet set
MsgBox "Sheet Set Name: " + sheetSetDatabase.GetSheetSet().GetName() + vbCrLf + _
"Sheet Set Description: " + sheetSetDatabase.GetSheetSet().GetDesc()
Dim enumerator As IAcSmEnumPersist
Dim itemSheetSet As IAcSmPersist
' Get the enumerator for the objects in the sheet set
Set enumerator = sheetSetDatabase.GetEnumerator()
Set itemSheetSet = enumerator.Next()
' Step through the objects in the sheet set
Do While Not itemSheetSet Is Nothing
' Increment the counter of the object is a sheet
If itemSheetSet.GetTypeName() = "AcSmSubset" Then
Dim subset As AcSmSubset
Set subset = itemSheetSet
Dim enumSheets As IAcSmEnumComponent
Dim itemSheet As IAcSmPersist
Dim sheet As AcSmSheet
Set enumSheets = subset.GetSheetEnumerator()
Set itemSheet = enumSheets.Next()
Do While Not itemSheet Is Nothing
Set sheet = itemSheet
MsgBox "Subset Name: " + subset.GetName() & vbLf & "Sheet Name: " + sheet.GetName()
' Get next object
Set itemSheet = enumSheets.Next()
Loop
End If
' Get next object
Set itemSheetSet = enumerator.Next()
Loop
' Close the sheet set
sheetSetManager.Close sheetSetDatabase
End Sub
Lee Ambrosius
Senior Principal Content Experience Designer
For additional help, check out the AutoCAD Developer Documentation