pagesetup import

bkenyon13 · ‎05-22-2012

Can someone help me with this, for some reason I just cannot get this to work.

with the code below I get an error saying eWasOpenForWrite, but I am not sure how to get it set to read.

I already have the layout that I want in the dwg(s) that I am creating so I do not want to copy an entire layout, I just want the pagesetups from a another dwg.

Code:

Dim db As New Database(True, False)
                db.ReadDwgFile(ssf & sheetinfo.SheetName.Text & ".dwg", FileOpenMode.OpenForReadAndAllShare, False, "")
                Using trans As Transaction = db.TransactionManager.StartTransaction()
                    Dim lytmgr As LayoutManager = LayoutManager.Current
                    Dim lyt As Layout = trans.GetObject(lytmgr.GetLayoutId(lytmgr.CurrentLayout), OpenMode.ForWrite)
                    Dim pd As DBDictionary = trans.GetObject(db.PlotSettingsDictionaryId, OpenMode.ForRead)
                    For Each pentry As DictionaryEntry In pd
                        pd.UpgradeOpen()
                        pd.Remove(pentry.Value)
                        pd.DowngradeOpen()
                    Next
                    Dim pdps As PlotSettings = New PlotSettings(False)
                    pdps.CopyFrom(GetPlotSettings)
                    Dim psv As PlotSettingsValidator = PlotSettingsValidator.Current
                    pdps.AddToPlotSettingsDictionary(db)
                    lyt.DowngradeOpen()
                    trans.Commit()
                End Using
                db.SaveAs(ssf & sheetinfo.SheetName.Text & ".dwg", DwgVersion.Current)
                db.CloseInput(True)
                db.Dispose()


Private Function GetPlotSettings()
        Dim psdb As New Database(False, True)
        Using trns As Transaction = psdb.TransactionManager.StartTransaction()
            psdb.ReadDwgFile("C:\Users\Barclay\Documents\PSTest.dwg", FileOpenMode.OpenForReadAndReadShare, True, "")
            Dim psps As PlotSettings = New PlotSettings(False)
            Dim psd As DBDictionary = trns.GetObject(psdb.PlotSettingsDictionaryId, OpenMode.ForRead)
            For Each psentry As DictionaryEntry In psd
                psps = trns.GetObject(psentry.Value, OpenMode.ForRead)
            Next
            Return psps
        End Using
    End Function

bkenyon13 · ‎05-22-2012

give me time and I seem to be able to figure things out.

found that I was missing:

pdps.downgradeopen() after pdps.addtoplotsettings()

I then had the issue with autocad crashing and found that was resolved when adding:

pdps.dispose() after trans.commit()

now if I can setup the plot setting that I want current in the whole porcess. Not exactly sure where to start on that, I have looked through posts on here, but have not been able to find anything deffinitive answer on how to do it.

of course I am probably missing something somewhere

thnx for help in advance

bkenyon13 · ‎05-22-2012

sorry for the replies to myself.

ok the original code I posted and fixed would only copy one pagesetup for some reason, so I was able to figure out how to get all the pagesetups to copy from the dwg file. However in doing this everytime I run the code autocad gives a fatal exception.

can someone please help me get it this to work?

Code:

Imports Autodesk.AutoCAD.Runtime
Imports ACSMCOMPONENTS18Lib
Imports Autodesk.AutoCAD.Windows
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Geometry

Public Class Class1
    'Specifies the command to use
    <CommandMethod("psetup")> _
    Public Sub plansetup()
        Dim doc As DocumentCollection = Application.DocumentManager
        'Get a reference to the Sheet Set Manager object
        Dim ssm As New AcSmSheetSetMgr
        'Selects the save location of the sheet set
        Dim sfd As New SaveFileDialog(title:="Save Location", defaultName:="", dialogName:="Save Location", extension:="dst", flags:=SaveFileDialog.SaveFileDialogFlags.NoFtpSites)
        sfd.ShowDialog()
        'Create a new sheet set file
        Dim ssdb As AcSmDatabase
        ssdb = ssm.CreateDatabase(sfd.Filename, "", True)
        Dim info As SheetSetInfo = New SheetSetInfo
        info.ShowDialog()
        Dim ssf As String
        ssf = Mid(ssdb.GetFileName, 1, InStrRev(ssdb.GetFileName, "\"))
        'Locks the database
        ssdb.LockDb(ssdb)
        'Get the sheet set
        Dim sss As AcSmSheetSet
        sss = ssdb.GetSheetSet
        'Set Custom Properties of the sheet set
        SetCustomProperty(sss, "Author", info.AuthorTxt.Text, PropertyFlags.CUSTOM_SHEETSET_PROP)
        SetCustomProperty(sss, "County", info.CountyTxt.Text, PropertyFlags.CUSTOM_SHEETSET_PROP)
        SetCustomProperty(sss, "Job Date", info.JobDateTxt.Text, PropertyFlags.CUSTOM_SHEETSET_PROP)
        SetCustomProperty(sss, "Job Name", info.JobNameTxt.Text, PropertyFlags.CUSTOM_SHEETSET_PROP)
        SetCustomProperty(sss, "Job Number", info.JobNumberTxt.Text, PropertyFlags.CUSTOM_SHEETSET_PROP)
        SetCustomProperty(sss, "Job Type", info.JobTypeTxt.Text, PropertyFlags.CUSTOM_SHEETSET_PROP)
        SetCustomProperty(sss, "Owner / Developer", info.OwnerTxt.Text, PropertyFlags.CUSTOM_SHEETSET_PROP)
        SetCustomProperty(sss, "Street", info.StreetTxt.Text, PropertyFlags.CUSTOM_SHEETSET_PROP)
        SetCustomProperty(sss, "Total Sheets", info.TotalSheetNum.Value.ToString, PropertyFlags.CUSTOM_SHEETSET_PROP)
        SetCustomProperty(sss, "Town", info.TownTxt.Text, PropertyFlags.CUSTOM_SHEETSET_PROP)
        SetCustomProperty(sss, "Township", info.MunicipalityTxt.Text, PropertyFlags.CUSTOM_SHEETSET_PROP)
        Dim efd As New OpenFileDialog(title:="Select Existing Xref", defaultName:="", dialogName:="Select Existing Xref", extension:="dwg", flags:=OpenFileDialog.OpenFileDialogFlags.NoFtpSites)
        Dim pfd As New OpenFileDialog(title:="Select Proposed Xref", defaultName:="", dialogName:="Select Proposed Xref", extension:="dwg", flags:=OpenFileDialog.OpenFileDialogFlags.NoFtpSites)
        Dim profd As New OpenFileDialog(title:="Select Profile Xref", defaultName:="", dialogName:="Select Profile Xref", extension:="dwg", flags:=OpenFileDialog.OpenFileDialogFlags.NoFtpSites)
        Dim secfd As New OpenFileDialog(title:="Select Section Xref", defaultname:="", dialogName:="Select Section Xref", extension:="dwg", flags:=OpenFileDialog.OpenFileDialogFlags.NoFtpSites)
        Dim xrefd As New Xrefdia
        xrefd.ShowDialog()
        Dim sheetinfo As SheetProps = New SheetProps
        If xrefd.DialogResult = Windows.Forms.DialogResult.Yes Then
            efd.ShowDialog()
            pfd.ShowDialog()
            For i As Integer = 1 To info.TotalSheetNum.Value
                sheetinfo.ShowDialog()
                If sheetinfo.SheetNum.Text = "1" Then
                    SetSheetSetDefaults(ssdb, sfd.Filename, "Description", ssf, "C:\Users\Barclay\Documents\lrgsht1a.dwt", "01 INDEX PLAN")
                Else
                    If sheetinfo.SheetNum.Text = "CS-01" Then
                        SetSheetSetDefaults(ssdb, sfd.Filename, "Description", ssf, "C:\Users\Barclay\Documents\lrgsht1a.dwt", "01 INDEX PLAN")
                    Else
                        SetSheetSetDefaults(ssdb, sfd.Filename, "Description", ssf, "C:\Users\Barclay\Documents\lrgsht2.dwt", "01 INDEX PLAN")
                    End If
                End If
                AddSheet(ssdb, sheetinfo.SheetName.Text, sheetinfo.SheetDesc.Text, sheetinfo.SheetNum.Text, sheetinfo.SheetName.Text)
                Dim db As New Database(True, False)
                If sheetinfo.SheetName.Text = "Pipe Profiles" Then
                    profd.ShowDialog()
                    db.ReadDwgFile(ssf & sheetinfo.SheetName.Text & ".dwg", FileOpenMode.OpenForReadAndAllShare, False, "")
                    Dim profid As ObjectId = db.OverlayXref(profd.Filename, profd.Filename)
                    Using trans As Transaction = db.TransactionManager.StartTransaction()
                        Dim bt As BlockTable = TryCast(db.BlockTableId.GetObject(OpenMode.ForRead), BlockTable)
                        Dim btr As BlockTableRecord = TryCast(bt(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForWrite), BlockTableRecord)
                        Dim bref As New BlockReference(Point3d.Origin, profid)
                        Dim srcdb As New Database(False, True)
                        srcdb.ReadDwgFile("C:\Users\Barclay\Documents\PSTest.dwg", FileOpenMode.OpenForReadAndReadShare, True, "")
                        GetPlotSettings(srcdb, db)
                        btr.AppendEntity(bref)
                        trans.AddNewlyCreatedDBObject(bref, True)
                        trans.Commit()
                    End Using
                    db.SaveAs(ssf & sheetinfo.SheetName.Text & ".dwg", DwgVersion.Current)
                    db.CloseInput(True)
                    db.Dispose()
                Else
                    If sheetinfo.SheetName.Text = "Basin Sections" Then
                        secfd.ShowDialog()
                        db.ReadDwgFile(ssf & sheetinfo.SheetName.Text & ".dwg", FileOpenMode.OpenForReadAndAllShare, False, "")
                        Dim secid As ObjectId = db.OverlayXref(secfd.Filename, secfd.Filename)
                        Using trans As Transaction = db.TransactionManager.StartTransaction()
                            Dim bt As BlockTable = TryCast(db.BlockTableId.GetObject(OpenMode.ForRead), BlockTable)
                            Dim btr As BlockTableRecord = TryCast(bt(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForWrite), BlockTableRecord)
                            Dim bref As New BlockReference(Point3d.Origin, secid)
                            Dim srcdb As New Database(False, True)
                            srcdb.ReadDwgFile("C:\Users\Barclay\Documents\PSTest.dwg", FileOpenMode.OpenForReadAndReadShare, True, "")
                            GetPlotSettings(srcdb, db)
                            btr.AppendEntity(bref)
                            trans.AddNewlyCreatedDBObject(bref, True)
                            trans.Commit()
                        End Using
                        db.SaveAs(ssf & sheetinfo.SheetName.Text & ".dwg", DwgVersion.Current)
                        db.CloseInput(True)
                        db.Dispose()
                    Else
                        db.ReadDwgFile(ssf & sheetinfo.SheetName.Text & ".dwg", FileOpenMode.OpenForReadAndAllShare, False, "")
                        Dim xrefid As ObjectId = db.OverlayXref(efd.Filename, efd.Filename)
                        Dim xrefid2 As ObjectId = db.OverlayXref(pfd.Filename, pfd.Filename)
                        Using trans As Transaction = db.TransactionManager.StartTransaction()
                            Dim bt As BlockTable = TryCast(db.BlockTableId.GetObject(OpenMode.ForRead), BlockTable)
                            Dim btr As BlockTableRecord = TryCast(bt(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForWrite), BlockTableRecord)
                            Dim bref As New BlockReference(Point3d.Origin, xrefid)
                            Dim bref2 As New BlockReference(Point3d.Origin, xrefid2)
                            Dim srcdb As New Database(False, True)
                            srcdb.ReadDwgFile("C:\Users\Barclay\Documents\PSTest.dwg", FileOpenMode.OpenForReadAndReadShare, True, "")
                            GetPlotSettings(srcdb, db)
                            btr.AppendEntity(bref)
                            btr.AppendEntity(bref2)
                            trans.AddNewlyCreatedDBObject(bref, True)
                            trans.AddNewlyCreatedDBObject(bref2, True)
                            trans.Commit()
                        End Using
                        db.SaveAs(ssf & sheetinfo.SheetName.Text & ".dwg", DwgVersion.Current)
                        db.CloseInput(True)
                        db.Dispose()
                    End If
                End If
            Next
        Else
            For i As Integer = 1 To info.TotalSheetNum.Value
                sheetinfo.ShowDialog()
                If sheetinfo.SheetNum.Text = "1" Then
                    SetSheetSetDefaults(ssdb, sfd.Filename, "Description", ssf, "C:\Users\Barclay\Documents\lrgsht1a.dwt", "01 INDEX PLAN")
                Else
                    If sheetinfo.SheetNum.Text = "CS-01" Then
                        SetSheetSetDefaults(ssdb, sfd.Filename, "Description", ssf, "C:\Users\Barclay\Documents\lrgsht1a.dwt", "01 INDEX PLAN")
                    Else
                        SetSheetSetDefaults(ssdb, sfd.Filename, "Description", ssf, "C:\Users\Barclay\Documents\lrgsht2.dwt", "01 INDEX PLAN")
                    End If
                End If
                AddSheet(ssdb, sheetinfo.SheetName.Text, sheetinfo.SheetDesc.Text, sheetinfo.SheetNum.Text, sheetinfo.SheetName.Text)
                Dim db As New Database(True, False)
                db.ReadDwgFile(ssf & sheetinfo.SheetName.Text & ".dwg", FileOpenMode.OpenForReadAndAllShare, False, "")
                Dim srcdb As New Database(False, True)
                srcdb.ReadDwgFile("C:\Users\Barclay\Documents\PSTest.dwg", FileOpenMode.OpenForReadAndReadShare, True, "")
                GetPlotSettings(srcdb, db)
                db.SaveAs(ssf & sheetinfo.SheetName.Text & ".dwg", DwgVersion.Current)
                db.CloseInput(True)
                db.Dispose()
            Next
        End If
        'Unlocks the database
        ssdb.UnlockDb(ssdb)
        'Closes the database
        ssm.Close(ssdb)
    End Sub
    Private Function GetPlotSettings(ByVal sourcedatabase As Database, ByVal currentdatabase As Database)
        Using trans As Transaction = sourcedatabase.TransactionManager.StartTransaction
            Using trns As Transaction = currentdatabase.TransactionManager.StartTransaction
                Dim psd As DBDictionary = trans.GetObject(sourcedatabase.PlotSettingsDictionaryId, OpenMode.ForRead)
                Dim id As ObjectId
                Dim pd As DBDictionary = trns.GetObject(currentdatabase.PlotSettingsDictionaryId, OpenMode.ForRead)
                For Each ent As DBDictionaryEntry In pd
                    pd.UpgradeOpen()
                    pd.Remove(ent.Value)
                    pd.DowngradeOpen()
                Next
                For Each entry As DBDictionaryEntry In psd
                    id = psd.GetAt(entry.Key)
                    Dim ps As PlotSettings = id.GetObject(OpenMode.ForRead)
                    Dim curps As PlotSettings = New PlotSettings(False)
                    curps.CopyFrom(ps)
                    curps.AddToPlotSettingsDictionary(currentdatabase)
                    trns.Commit()
                    curps.Dispose()
                Next

            End Using
        End Using
    End Function
    ' Used to add a sheet to a sheet set
    ' Note: This function is dependent on a Default Template and Storage location
    ' being set for the sheet set
    Private Function AddSheet(ByVal component As IAcSmComponent, ByVal name As String, ByVal desc As String, ByVal number As String, ByVal title As String) As AcSmSheet
        Dim sheet As AcSmSheet
        
        sheet = component.GetDatabase().GetSheetSet().AddNewSheet(name, _
                                                                  desc)
        ' Add the sheet as the first one in the sheet set
        component.GetDatabase().GetSheetSet().InsertComponentAfter(sheet, Nothing)
        ' Set the number and title of the sheet
        sheet.SetNumber(number)
        sheet.SetTitle(title)
        AddSheet = sheet
    End Function
    ' Set the default properties of a sheet set
    Private Sub SetSheetSetDefaults(ByVal sheetSetDatabase As AcSmDatabase, _
                                    ByVal name As String, _
                                    ByVal description As String, _
                                    Optional ByVal newSheetLocation As String = "", _
                                    Optional ByVal newSheetDWTLocation As String = "", _
                                    Optional ByVal newSheetDWTLayout As String = "", _
                                    Optional ByVal promptForDWT As Boolean = False)

        ' Set the Name and Description for the sheet set
        sheetSetDatabase.GetSheetSet().SetName(name)
        sheetSetDatabase.GetSheetSet().SetDesc(description)

        ' Check to see if a Storage Location was provided
        If newSheetLocation <> "" Then
            ' Get the folder the sheet set is stored in
            Dim sheetSetFolder As String
            sheetSetFolder = Mid(sheetSetDatabase.GetFileName(), 1, _
                                 InStrRev(sheetSetDatabase.GetFileName(), "\"))

            ' Create a reference to a File Reference object
            Dim fileReference As IAcSmFileReference
            fileReference = sheetSetDatabase.GetSheetSet().GetNewSheetLocation()

            ' Set the default storage location based on the location of the sheet set
            fileReference.SetFileName(sheetSetFolder)

            ' Set the new Sheet location for the sheet set
            sheetSetDatabase.GetSheetSet().SetNewSheetLocation(fileReference)
        End If

        ' Check to see if a Template was provided
        If newSheetDWTLocation <> "" Then
            ' Set the Default Template for the sheet set
            Dim layoutReference As AcSmAcDbLayoutReference
            layoutReference = sheetSetDatabase.GetSheetSet().GetDefDwtLayout()

            ' Set the template location and name of the layout 
            ' for the Layout Reference object
            layoutReference.SetFileName(newSheetDWTLocation)
            layoutReference.SetName(newSheetDWTLayout)

            ' Set the Layout Reference for the sheet set
            sheetSetDatabase.GetSheetSet().SetDefDwtLayout(layoutReference)
        End If

        ' Set the Prompt for Template option of the subset
        sheetSetDatabase.GetSheetSet().SetPromptForDwt(promptForDWT)
    End Sub
    ' Set/create a custom sheet or sheet set property
    Private Sub SetCustomProperty(ByVal owner As IAcSmPersist, _
                                  ByVal propertyName As String, _
                                  ByVal propertyValue As Object, _
                                  ByVal sheetSetFlag As PropertyFlags)

        ' Create a reference to the Custom Property Bag
        Dim customPropertyBag As AcSmCustomPropertyBag

        ' Create a reference to a Custom Property Value
        Dim customPropertyValue As AcSmCustomPropertyValue = New AcSmCustomPropertyValue()

        If owner.GetTypeName() = "AcSmSheet" Then
            Dim sheet As AcSmSheet = owner
            customPropertyBag = sheet.GetCustomPropertyBag()
            customPropertyValue.InitNew(sheet)
        Else
            Dim sheetSet As AcSmSheetSet = owner
            customPropertyBag = sheetSet.GetCustomPropertyBag()
            customPropertyValue.InitNew(sheetSet)
        End If

        ' Set the flag for the property
        customPropertyValue.SetFlags(sheetSetFlag)

        ' Set the value for the property
        customPropertyValue.SetValue(propertyValue)

        ' Create the property
        customPropertyBag.SetProperty(propertyName, customPropertyValue)
    End Sub
End Class

pagesetup import

pagesetup import

Forums Links

Post to forums