Code:
<CommandMethod("checkdwg")> _
Public Sub Check_Zeichnung()
'' Get the current document and database, and start a transaction
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database xls_Appl = New Excel.Application() ' Excel Instanz bilden
xls_Mappe = xls_Appl.Workbooks.Open("C:\ProgramData\zvwin\acad\v2010\zvw\ing\vorlagen\Vorlage_Zeichnungsprüfung.xls")
xls_Blatt = xls_Mappe.Worksheets("Layer_0")
xls_Blatt1 = xls_Mappe.Worksheets("VonLayer")
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
Try
'' Open the Block table record for read
Dim acBlkTbl As BlockTable
acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, _
OpenMode.ForRead)
'' Open the Block table record Model space for read
Dim acBlkTblRec As BlockTableRecord
acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), _
OpenMode.ForRead)
acDoc.Editor.WriteMessage(vbLf & "Model space objects: ")
'' Step through each object in Model space and
'' display the type of object found
Dim nCnt As Integer = 0
Dim nCnt1 As Integer = 0
For Each acObjId As ObjectId In acBlkTblRec
If acBlkTblRec.XrefStatus = XrefStatus.NotAnXref Then
If (acObjId.IsValid) AndAlso (Not acObjId.IsErased) Then
Dim ent As Entity = CType(acTrans.GetObject(acObjId, OpenMode.ForRead), Entity)
If ent.Layer = "0" Then
acDoc.Editor.WriteMessage(vbLf + "Type: " & Split(ent.GetType.ToString, "Autodesk.AutoCAD.DatabaseServices.")(1) & " auf Layer 0")
xls_Blatt.Cells(nCnt + 4, 1).Value = Split(ent.GetType.ToString, "Autodesk.AutoCAD.DatabaseServices.")(1)
acDoc.Editor.WriteMessage(vbLf + "Koordinaten: " & ent.GeometricExtents.MinPoint.ToString)
xls_Blatt.Cells(nCnt + 4, 2).Value = ent.GeometricExtents.MinPoint.ToString
nCnt = nCnt + 1
End If
If Not ent.Color.ToString Like "VON*" Then
acDoc.Editor.WriteMessage(vbLf + "Type: " & Split(ent.GetType.ToString, "Autodesk.AutoCAD.DatabaseServices.")(1) & " auf Layer 0")
xls_Blatt1.Cells(nCnt1 + 4, 1).Value = Split(ent.GetType.ToString, "Autodesk.AutoCAD.DatabaseServices.")(1)
acDoc.Editor.WriteMessage(vbLf + "Koordinaten: " & ent.Color.ToString)
xls_Blatt1.Cells(nCnt1 + 4, 2).Value = ent.GeometricExtents.MinPoint.ToString
acDoc.Editor.WriteMessage(vbLf + "Farbe: " & ent.Color.ToString)
xls_Blatt1.Cells(nCnt1 + 4, 3).Value = ent.Color.ToString
nCnt1 = nCnt1 + 1
End If
End If
End If
Next
acDoc.Editor.WriteMessage(vbLf & nCnt1 & " Objekte gefunden")
acDoc.Editor.WriteMessage(vbLf & nCnt & " Objekte geändert")
'Falls keine Objekte gefunden
If nCnt = 0 Then
acDoc.Editor.WriteMessage(vbLf & " Keine Objekte gefunden")
Else
acTrans.Commit() 'commit TransAction
End If
'Zeichnung Regenerieren
acDoc.SendStringToExecute("._REGEN ", True, False, False)
'Excel-Datei speichern und evtl vorh. Datei überschreiben
Dim sUser As String = My.User.Name
Dim path As String = System.Environment.GetEnvironmentVariable("USERPROFILE")
xls_Appl.DisplayAlerts = False
Dim strTeile() As String
Dim strDateiNameGanz As String = acDoc.Name.ToString
strTeile = strDateiNameGanz.Split("\")
Dim filename As String = path & "\" & Split(strTeile(strTeile.Length - 1), ".dwg")(0) & "_Prüfung.xls"
xls_Appl.Visible = True
xls_Mappe.SaveAs(filename)
xls_Appl.DisplayAlerts = True
xls_Appl.Quit()
killExcelInstanceById(xls_Appl)
xls_Appl = Nothing
xls_Blatt = Nothing
xls_Mappe = Nothing
'Abfrage ob die Datei geöffnet werden soll
Dim antwort As String = MsgBox("Die Datei wurde unter" & vbLf & filename & vbLf & _
"gespeichert" & vbLf & vbLf & _
"Soll die Datei geöffnet werden?", MsgBoxStyle.YesNo)
If antwort = vbYes Then
'Excel-Datei öffnen
Process.Start(filename)
Else
End If
Catch ex As Autodesk.AutoCAD.Runtime.Exception
acDoc.Editor.WriteMessage(ex.Message)
End Try
End Using
End Sub