Need help creating subsets plz

[Anonymous]

I'm using MEP2008 and I'm trying to get a subset created in my sheetset which I can do with the following code, however I can't get it to do it correctly. I have a "Sheets" subfolder in my project where my subsets are suposed to be created but I can"t figure out how to get my code to create the the subsets in this location, so I would end up with ProjPath\Sheets\Newsubset\*.dwgs
Can someone tell me how to tell vb to create new subsets in my "Sheets" folder?

Option Explicit
' Create a Sheet and a Subset in the root of the sheet set
' You must add a reference to the AcSmComponents library for this to work.

Public Sub Add_ShtSub()

Dim oEnumDb As IAcSmEnumDatabase
Dim oItem As IAcSmPersist
Dim oSheetDb As AcSmDatabase

' create reference to sheet set manager
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
Set oSheetDb = oItem
' get next open database
Set oItem = oEnumDb.Next
Loop

' Lock the Database
LockDatabase oSheetDb

' Specify default template and layout.
Dim oLayoutRef As AcSmAcDbLayoutReference
Set oLayoutRef = oSheetDb.GetSheetSet().GetDefDwtLayout
oLayoutRef.SetFileName "O:\Comm_Custom\Template\Commodore Sheet.dwt"
oLayoutRef.SetName "Arch A (8.5 x 11)"


' call addsheet function
AddSheet oSheetDb, "mytitle", "mydesc", "t1"


'' To add a Subset to the root of the sheet set you need from here.......
Dim oSubset As AcSmSubset
Set oSubset = CreateSubset(oSheetDb, "mySubset", "mySubsetDesc", "", _
"O:\Comm_Custom\Template\Commodore Sheet.dwt", _
"Arch A (8.5 x 11)")
'' To here and the function of course.

' Unlock the database
UnlockDatabase oSheetDb

Set oEnumDb = Nothing
Set oSheetSetMgr = Nothing

End Sub

'' Add a Sheet to the Sheet Set
'' This function is dependent on a Default Template and Storage location being setup for the Sheet Set of Subset
Private Function AddSheet(oComp As IAcSmComponent, _
strTitle As String, _
strDesc As String, _
strNumber As String) As AcSmSheet

'' Create a new Sheet based on the template and location defined by the Sheet Set
Set AddSheet = oComp.GetDatabase().GetSheetSet().AddNewSheet(strTitle, strDesc)

'' This sets the file name
AddSheet.SetName strTitle
'' Add the Title to the Sheet
AddSheet.SetTitle strTitle
'' Add the Number to the Sheet
AddSheet.SetNumber strNumber
'' Add the Sheet to the Root of the Sheet Set
oComp.GetDatabase().GetSheetSet().InsertComponent AddSheet, Nothing ''
oComp.GetDatabase().GetSheetSet().GetSheetEnumerator().Next
' End If
End Function

'' Create a Subset in a Sheet Set
Private Function CreateSubset(oSheetDb As AcSmDatabase, _
strName As String, _
strDesc As String, _
Optional strNewSheetLocation As String = "", _
Optional strNewSheetDWTLocation As String = "", _
Optional strNewSheetDWTLayout As String = "", _
Optional bPromptForDWT As Boolean = True) As AcSmSubset

'' Create a Subset with the provided name and description
Set CreateSubset = oSheetDb.GetSheetSet().CreateSubset(strName, strDesc)

'' Get the Folder the Sheet Set is Stored in
Dim strSheetSetFldr As String
strSheetSetFldr = Mid(oSheetDb.GetFileName, 1, InStrRev(oSheetDb.GetFileName, "\"))
'' Need to add to the path because we are in MEP not Plain ol' AutoCAD

'''Dim aaa As String
'''aaa = oSheetDb.GetSheetSet.GetNewSheetLocation.GetFileName
'''strSheetSetFldr = aaa & "\" & strName & "\"

'' Create a reference to a File Reference object
Dim oFileRef As IAcSmFileReference
Set oFileRef = CreateSubset.GetNewSheetLocation

'' Check to see if a path was provided, if not default to the Sheet Set location
If strNewSheetLocation "" Then
oFileRef.SetFileName strNewSheetLocation
Else
oFileRef.SetFileName strSheetSetFldr
End If

'' Set the new sheet location for the Subset
CreateSubset.SetNewSheetLocation oFileRef

'' Create a reference to a Layout Reference object
Dim oLayoutRef As AcSmAcDbLayoutReference
Set oLayoutRef = CreateSubset.GetDefDwtLayout

'' Check to see that a default DWT Location was passed in
If strNewSheetDWTLocation "" Then
'' Set the location of the template in the Layout Reference object
oLayoutRef.SetFileName strNewSheetDWTLocation
'' Set the Layout name for the Layout Reference object
oLayoutRef.SetName strNewSheetDWTLayout
'' Set the Layout Reference to the Subset
CreateSubset.SetDefDwtLayout oLayoutRef
End If

'' Set the Prompt for Template option of the Subset when a new Sheet is created
CreateSubset.SetPromptForDwt bPromptForDWT
End Function

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

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 Message was edited by: Loki