Code:
Dim doc As Document = Nothing
Dim ed As EditorInput.Editor = Nothing
Dim doclock As DocumentLock = Nothing
Dim db As Database = Nothing
Dim PlotDevList As Collections.Specialized.StringCollection = Nothing
Dim tr As Transaction = Nothing
Dim OldDevName As String
Dim OldMediaName As String
Dim medianame As String = ""
Dim dTmpPaperSizeX As Double
Dim dTmpPaperSizeY As Double
Dim MinPoint As Geometry.Point2d
Dim myLM As LayoutManager = Nothing
Dim La As DatabaseServices.Layout = Nothing
Dim piv As PlottingServices.PlotInfoValidator = Nothing
Dim ps As DatabaseServices.PlotSettings = Nothing
Dim PSV As DatabaseServices.PlotSettingsValidator = Nothing
Dim pi As PlottingServices.PlotInfo = Nothing
Dim PlotWindow As DatabaseServices.Extents2d = Nothing
Dim tmpMedName As String = ""
Dim lastMedianame As String = ""
Dim Border As BlockReference
Dim medianames As Specialized.StringCollection = Nothing
Dim bFoundPaperFoundFlag As Boolean = Falsedoc = ApplicationServices.Application.DocumentManager.MdiActiveDocument
ed = doc.Editor
doclock = doc.LockDocument
db = doc.Database
tr = db.TransactionManager.StartTransaction()
myLM = DatabaseServices.LayoutManager.Current
La = CType(tr.GetObject(Layoutid, DatabaseServices.OpenMode.ForWrite, False, True), Layout)
Border = CType(tr.GetObject(Borderid, DatabaseServices.OpenMode.ForRead, False, True), BlockReference)
myLM.CurrentLayout = La.LayoutName
ps = New DatabaseServices.PlotSettings(False)
ps.CopyFrom(La)
PSV = DatabaseServices.PlotSettingsValidator.Current
PSV.RefreshLists(ps)
pi = New PlottingServices.PlotInfo()
pi.Layout = La.ObjectId
piv = New PlottingServices.PlotInfoValidator()
piv.MediaMatchingPolicy = PlottingServices.MatchingPolicy.MatchEnabled
'Alte Werte holen
OldDevName = ps.PlotConfigurationName
OldMediaName = ps.CanonicalMediaName
PlotWindow = New DatabaseServices.Extents2d(0, 0, Border.GeometricExtents.MaxPoint.X, Border.GeometricExtents.MaxPoint.Y)
PlotDevList = PSV.GetPlotDeviceList()
If PlotDevList.Contains(PlotDevName) Then
dTmpPaperSizeX = Round(Border.GeometricExtents.MaxPoint.X - Border.GeometricExtents.MinPoint.X, 0)
dTmpPaperSizeY = Round(Border.GeometricExtents.MaxPoint.Y - Border.GeometricExtents.MinPoint.Y, 0)
MinPoint = New Geometry.Point2d(Border.GeometricExtents.MinPoint.X, Border.GeometricExtents.MinPoint.Y)
PSV.SetPlotConfigurationName(La, PlotDevName, Nothing)
PSV.RefreshLists(ps)
PlotDevList = PSV.GetPlotDeviceList()
medianames = PSV.GetCanonicalMediaNameList(La)
bFoundPaperFoundFlag = False
'Liste durchgehen und schauen ob die Rahmengröße gleich einer Papiergröße ist, falls nicht, auf vorigen Wert zurücksetzen
For Each MedName As String In medianames
If MedName <> "" Then
Try
PSV.SetPlotConfigurationName(La, PlotDevName, MedName)
Catch ex As Exception
MsgBox("error setting medianame:" & MedName)
End Try
End If
If Abs(PaperSizeY - Round(La.PlotPaperSize.X)) < 10 And Abs(PaperSizeX - Round(La.PlotPaperSize.Y)) < 10 Then
bFoundPaperFoundFlag = True
Exit For
End If
Next
If bFoundPaperFoundFlag = False Then
PSV.SetPlotConfigurationName(ps, OldDevName, OldMediaName)
End If
End If
'Try
PSV.SetClosestMediaName(ps, PaperSizeX, PaperSizeY, PlotPaperUnit.Millimeters, False)
'Catch ex As Exception
' MsgBox("Fehler setClosestMediaName:" & dTmpPaperSizeX & "-" & dTmpPaperSizeY & vbNewLine & _
' ex.Message & vbNewLine & ex.StackTrace)
'End Try
PSV.SetCurrentStyleSheet(ps, PlotStyleName)
PSV.SetPlotType(ps, Autodesk.AutoCAD.DatabaseServices.PlotType.Extents)
PSV.SetPlotWindowArea(ps, PlotWindow)
PSV.SetPlotOrigin(ps, New Geometry.Point2d(Border.GeometricExtents.MaxPoint.X, Border.GeometricExtents.MaxPoint.Y))
PSV.SetPlotType(ps, Autodesk.AutoCAD.DatabaseServices.PlotType.Layout)
PSV.SetStdScaleType(ps, StdScaleType.StdScale1To1)
PSV.SetUseStandardScale(ps, True)
PSV.SetStdScale(ps, 1)
PSV.SetPlotPaperUnits(ps, PlotPaperUnit.Millimeters)
PSV.SetPlotRotation(ps, PlotRotation.Degrees000)
ps.ScaleLineweights = True
pi.OverrideSettings = ps
piv.Validate(pi)
La.CopyFrom(pi.ValidatedSettings)
MsgBox("la plotsettingsname:" & La.PlotSettingsName)
tr.Commit()