Fehlermeldung bei XREF einbinden (Autodesk/AutoCAD ObjectARX und .NET)

Moin!

ich möchte XREF-Dateien einbinden.

Hierzu habe ich eine Vorlage auf https://www.theswamp.org/index.php?topic=31863.0 gefunden und nach vb.net konvertiert.

Mein Code, wo ich das Abfragen des Einfügepunktes durch einen Übergabeparameter ersetzt habe, sieht wie folgt aus:

Code:

Imports System.IO
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Public Class XRef
Private _AcLog As EBL.AcadLogger.AcLog
Private _TryReport As New EBL.Logger.TryCatchReport
Public Sub New(AcLog As EBL.AcadLogger.AcLog)
If Not IsNothing(AcLog) Then _AcLog = AcLog
End Sub
''' <summary>
''' Xref(s) anhängen
''' </summary>
''' <param name="fileNames">Dateinamen</param>
''' <param name="XrefLayer">optional aus welchem Layer ablegen (default:= 0)</param>
''' <param name="InsertPoint">optional Einfügepunkt (default:= nothing ... 0,0,0)</param>
Public Sub attach(ByVal fileNames As String(), Optional XrefLayer As String = "0", Optional InsertPoint As Point3d = Nothing)
Dim Editor As Autodesk.AutoCAD.EditorInput.Editor
Dim acDoc As Autodesk.AutoCAD.ApplicationServices.Document
'--- aus https://www.theswamp.org/index.php?topic=31863.0
acDoc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acDb As Database = acDoc.Database
Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
If IsNothing(InsertPoint) Then ' wenn keiner angegeben wird, dann 0,0,0
InsertPoint = New Point3d(0, 0, 0)
End If
Array.Sort(fileNames)
Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
Dim dimScale As Double = db.Dimscale
For Each fileName As String In fileNames
Try
''Dim options As PromptPointOptions = New PromptPointOptions("Pick insertion point for " & fileName & ": ")
''options.AllowNone = False
''Dim pt As PromptPointResult = Editor.GetPoint(options)
''If pt.Status <> PromptStatus.OK Then Continue For
Dim xrefScale As Double = getDwgScale(fileName)
Dim scaleFactor As Double = dimScale / xrefScale
Using tr As Transaction = Application.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction()
Dim xrefId As ObjectId = db.AttachXref(fileName, Path.GetFileNameWithoutExtension(fileName))
Dim blockRef As BlockReference = New BlockReference(InsertPoint, xrefId)
Dim layoutBlock As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
blockRef.ScaleFactors = New Scale3d(scaleFactor, scaleFactor, scaleFactor)
blockRef.Layer = XrefLayer
layoutBlock.AppendEntity(blockRef)
tr.AddNewlyCreatedDBObject(blockRef, True)
tr.Commit()
End Using
Catch ex As Exception
_TryReport.Show("unerwarteter Fehler in EBL.Acad > EBL_XREF > attach", "Filename:= " & fileName, ex.ToString, Log:=_AcLog)
End Try
Next
End Sub
Private Function getDwgScale(ByVal fileName As String) As Double
Using db As Database = New Database(False, True)
db.ReadDwgFile(fileName, FileOpenMode.OpenForReadAndAllShare, False, String.Empty)
Return db.Dimscale
End Using
End Function
End Class

Ich bekomme für die Zeile

Code:
Dim xrefId As ObjectId = db.AttachXref(fileName, Path.GetFileNameWithoutExtension(fileName))

Eine Fehlermeldung:
Autodesk.AutoCAD.Runtime.Exception: eFileAccessErr
bei Autodesk.AutoCAD.DatabaseServices.Database.AttachXref(String fileName, String blockName)
bei EBL.Acad.XRef.attach(String[] fileNames, String XrefLayer, Point3d InsertPoint) in C:\VSProjects\2019\EBL.Acad\EBL.Acad\EBL_XRef.vb:Zeile 46.

Hat einer von Euch eine Idee?

Gruß Jan

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

pitCAD Ultimate Basis + BIM ? Einzelplatz CAD APP für TGA, Facility Management, AEC - Architektur-, Ingenieur- und Bauwesen