Public Shared Function FuncCreateMaterial(ByVal nameMaterial As String, ByVal textureImageFilePath As String, ByVal height As Integer) As ObjectId
Dim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim imgWidth As Integer = 1
Dim imgHeight As Integer = 1
textureImageFilePath = textureImageFilePath & nameMaterial & ".jpg"
Using fs As FileStream = New FileStream(textureImageFilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Using img As System.Drawing.Image = System.Drawing.Image.FromStream(fs)
imgHeight = img.Size.Height
imgWidth = img.Size.Width
End Using
End Using
FuncCreateMaterial = Nothing
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
Try
Dim acBlkTbl As BlockTable = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)
Dim acBlkTblRec As BlockTableRecord = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Dim matLib As DBDictionary = acTrans.GetObject(acDoc.Database.MaterialDictionaryId, OpenMode.ForRead)
If matLib.Contains(nameMaterial) = False Then
Dim tex As ImageFileTexture = New ImageFileTexture()
tex.SourceFileName = textureImageFilePath
Dim uScale As Double = 1
Dim vScale As Double = 1 / height
Dim uOffset As Double = 0
Dim vOffset As Double = 0
Dim mx As Matrix3d = New Matrix3d(New Double() {uScale, 0, 0, uScale * uOffset, 0, vScale, 0, vScale * vOffset, 0, 0, 1, 0, 0, 0, 0, 1})
Dim mapper As Mapper = New Mapper(Projection.Cylinder, Tiling.Crop, Tiling.Crop, AutoTransform.None, mx)
Dim map
As MaterialMap
= New MaterialMap
(Source.
File, tex,
1.0, mapper
) Dim mdc As MaterialDiffuseComponent = New MaterialDiffuseComponent(New MaterialColor(), map)
Dim mrc As MaterialRefractionComponent = New MaterialRefractionComponent(2.0, map)
Dim mat As Material = New Material()
mat.Name = nameMaterial
mat.Diffuse = mdc
mat.Refraction = mrc
mat.Mode = Mode.Realistic
mat.Reflectivity = 1.0
mat.IlluminationModel = IlluminationModel.BlinnShader
matLib.UpgradeOpen()
FuncCreateMaterial = matLib.SetAt(nameMaterial, mat)
acTrans.AddNewlyCreatedDBObject(mat, True)
acTrans.Commit()
FuncCreateMaterial = mat.Id
Else
For Each idMat As DBDictionaryEntry In matLib
Dim matStr As String = idMat.Key
If matStr Like nameMaterial Then
FuncCreateMaterial = idMat.Value
End If
Next
End If
Catch
Exit Function
End Try
End Using
End Function
