Some of you have requested a code sample how to use the Sheet Set Manager API for AutoCAD 2005.
Here is one that you can
download and take a look at.
' Sheet Set Manager sample
' By Jimmy Bergmark
' Copyright (C) 2005 by JTB World
' www.jtbworld.com
' 2005-01-04
'
' SyncLayoutFileName works on the current opened sheet set
' It makes sure that the file name matches the Sheet number
' It makes sure that the layout name is the Sheet number
' concatenated with the Sheet title
' It includes code that shows who is locking the Sheet Set if it's locked
'
' Permission to use, copy, modify, and distribute this software
' for any purpose and without fee is hereby granted, provided
' that the above copyright notice appears in all copies and
' that both that copyright notice and the limited warranty and
' restricted rights notice below appear in all supporting
' documentation.
'
' JTB World PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
' JTB World SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
' MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. JTB World
' DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
' UNINTERRUPTED OR ERROR FREE.
Public Sub SyncLayoutFileName()
Dim i As Integer
' Return how many Sheets Sets that are open
i = SheetSetsOpen
If i > 1 Then
MsgBox "More than one Sheet Set are open. Make sure only one is open.", _
vbCritical
Exit Sub
ElseIf i = 0 Then
MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
Exit Sub
End If
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As IAcSmDatabase
Dim ss As AcSmSheetSet
If ssm Is Nothing Then
MsgBox "Something wrong here: 1", vbCritical
Exit Sub
End If
Set dbIter = ssm.GetDatabaseEnumerator
If dbIter Is Nothing Then
MsgBox "Something wrong here: 2", vbCritical
Exit Sub
End If
dbIter.Reset
'get the Database of the first sheetset
Set db = dbIter.Next
If db Is Nothing Then
MsgBox "No Sheet Set open", vbCritical
Exit Sub
End If
Set ss = db.GetSheetSet
If ss Is Nothing Then
MsgBox "Cannot get the Sheet Set", vbCritical
Exit Sub
End If
Set oSheetIter = ss.GetSheetEnumerator
If oSheetIter Is Nothing Then
Exit Sub
End If
Dim lockStatus As AcSmLockStatus
Let lockStatus = db.GetLockStatus
If lockStatus = AcSmLockStatus_UnLocked Then
db.LockDb db
Else
Call db.UnlockDb(db, True)
Let lockStatus = db.GetLockStatus
If lockStatus <> AcSmLockStatus_UnLocked Then
Dim sUserName As String
Dim sMachineName As String
db.GetLockOwnerInfo sUserName, sMachineName
MsgBox "The Sheet Set is locked by " & sUserName & _
" at " & sMachineName, vbCritical
Exit Sub
End If
End If
Dim compEnum As IAcSmEnumComponent
Set compEnum = ss.GetSheetEnumerator
Call LoopThroughSheets(compEnum)
Call db.UnlockDb(db, True)
End Sub
Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
Dim bChanged As Boolean
Dim comp As IAcSmComponent
Set comp = compEnum.Next()
Do While Not comp Is Nothing
If comp.GetTypeName = "AcSmSheet" Then
Dim s As AcSmSheet
Set s = comp
Dim sNumber As String
Dim sTitle As String
Debug.Print s.GetNumber
Debug.Print s.GetTitle
Debug.Print s.GetDesc
Dim oLayout As IAcSmNamedAcDbObjectReference
Set oLayout = s.GetLayout
Dim sRFN As String
bFileFound = True
On Error Resume Next
sRFN = oLayout.ResolveFileName
If Err.Number = -2147024894 Then
MsgBox "The file for Sheet " & oLayout.GetFileName & _
" cannot be found." & vbNewLine & "Number: " & _
s.GetNumber & " Title: " & s.GetTitle
bFileFound = False
End If
On Error GoTo 0
If bFileFound Then
ThisDrawing.Application.Documents.Open (sRFN)
ThisDrawing.ActiveSpace = acPaperSpace
ThisDrawing.MSpace = False
ZoomExtents
bChanged = False
If UCase(ThisDrawing.FullName) = UCase(sRFN) Then
sTitle = s.GetTitle
sNumber = s.GetNumber
' Can fail if there are multiple layouts
If ThisDrawing.Layouts.Count > 2 Then
MsgBox "This drawing has more than one layout " & _
"and there might result in some error", vbCritical
End If
If ThisDrawing.ActiveLayout.Name <> sNumber & " " & sTitle Then
If sNumber = "" Then
ThisDrawing.ActiveLayout.Name = sTitle
Else
ThisDrawing.ActiveLayout.Name = sNumber & " " & sTitle
End If
bChanged = True
End If
' Compare the referenced layout and file name
' The file name should be the same as the Sheet Number
Dim sSheetFileName As String
If s.GetNumber = "" Then
sSheetFileName = s.GetTitle & ".dwg"
MsgBox "The Sheet " & s.GetTitle & _
" doesn't have any Sheet Number so the Title is used as file name"
Else
sSheetFileName = s.GetNumber & ".dwg"
End If
If oLayout.GetName <> s.GetTitle Or _
UCase(sSheetFileName) <> UCase(ThisDrawing.Name) Then
oLayout.InitNew s
oLayout.SetName ThisDrawing.ActiveLayout.Name
If UCase(sSheetFileName) <> UCase(ThisDrawing.Name) Then
Dim oldFullName As String
Dim newFullName As String
newFullName = ThisDrawing.Path & "\" & sSheetFileName
If FileExists(newFullName) Then
MsgBox newFullName & " already exist"
End If
oldFullName = ThisDrawing.FullName
ThisDrawing.SaveAs newFullName
oLayout.SetFileName newFullName
On Error Resume Next
Kill (oldFullName)
On Error GoTo 0
Else
oLayout.SetFileName ThisDrawing.FullName
End If
End If
End If
ThisDrawing.Close bChanged
End If
ElseIf comp.GetTypeName = "AcSmSubset" Then
Dim sset As AcSmSubset
Set sset = comp
Call LoopThroughSheets(sset.GetSheetEnumerator)
End If
Set comp = compEnum.Next()
Loop
End Sub
Private Function FileExists(filename As String) As Boolean
On Error GoTo ErrorHandler
FileExists = (GetAttr(filename) And vbDirectory) = 0
ErrorHandler:
End Function
