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
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
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