插入光栅图纸（Raster Image）

Imports ZwSoft.ZwCAD.Runtime
Imports ZwSoft.ZwCAD.Geometry
Imports ZwSoft.ZwCAD.ApplicationServices
Imports ZwSoft.ZwCAD.DatabaseServices
Imports ZwSoft.ZwCAD.GraphicsSystem
Imports ZwSoft.ZwCAD.EditorInput


Public Class ZwApps


    _
    Public Sub InsertImage()
        Dim ZcDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim ZcDb As Database = ZcDoc.Database
        Using lockDocument As DocumentLock = ZcDoc.LockDocument
            Using ZcTrans As Transaction = ZcDb.TransactionManager.StartTransaction()
                Dim dictId As ObjectId = RasterImageDef.GetImageDictionary(ZcDb)


                If dictId.IsNull Then
                    dictId = RasterImageDef.CreateImageDictionary(ZcDb)
                End If


                'Open the image dictionary
                Dim dict As DBDictionary = DirectCast(ZcTrans.GetObject(dictId, OpenMode.ForRead), DBDictionary)


                Dim imageName As String = "test.jpeg"
                Dim imagePath As String = "F:/"
                Dim j As Integer = InStr(imageName, ".")


                Dim ImgSubName As String = Mid(imageName, 1, j - 1)
                Dim ImgExtName As String = Mid(imageName, j)


                Dim i As Integer = 0
                While dict.Contains(ImgSubName)
                    i += 1
                    ImgSubName = ImgSubName & i.ToString()
                End While
                Dim rid As New RasterImageDef()


                rid.SourceFileName = imagePath & ImgSubName & ImgExtName


                ' Load it
                rid.Load()
                dict.UpgradeOpen()


                Dim defId As ObjectId = dict.SetAt(ImgSubName, rid)
                ZcTrans.AddNewlyCreatedDBObject(rid, True)


                Dim Rimage As New RasterImage()
                Rimage.ImageDefId = defId


                Dim pro1 As New PromptPointOptions(vbLf & "Specify the insert point:")
                Dim proR1 As PromptPointResult = ZcDoc.Editor.GetPoint(pro1)
                If proR1.Status <> PromptStatus.OK Then
                    Return
                End If
                Dim insertPt As Point3d = proR1.Value


                Rimage.Orientation = New CoordinateSystem3d(insertPt, New Vector3d(1, 0, 0), New Vector3d(0, 1, 0))


                Dim zcBLT As BlockTable = ZcTrans.GetObject(ZcDb.BlockTableId, OpenMode.ForRead)
                Dim zcBLTR As BlockTableRecord = ZcTrans.GetObject(zcBLT(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
                zcBLTR.AppendEntity(Rimage)
                ZcTrans.AddNewlyCreatedDBObject(Rimage, True)


                ZcTrans.Commit()
            End Using
        End Using
        Dim ZwApp As Object = Application.ZcadApplication
        ZwApp.ZoomExtents()
    End Sub

End Class

imageName 和imagePath 需要根据实际情况作相应的修改。

执行InsertImage命令后，在图纸中指定插入点，即可将imageName 和imagePath所指定的光栅图插入到图纸当中。