TrueColorImages Example

Using Programming Languages other than VBA

Sub Example_TrueColorImages()
	' This example reads and modifies the preference value which determines
	' if raster and render images are displayed at True Color or palletized color.
	' When finished, this example resets the preference value back to
	' it's original value.
	' This example uses the "watch.jpg" found in the sample
	' directory. If you do not have this image, or it is located
	' in a different directory, insert a valid path and file name
	' for the imageName variable below.

	Dim ACADPref As AcadPreferencesDisplay
	Dim originalValue As Variant, newValue As Variant
	Dim insertionPoint(0 To 2) As Double
	Dim scalefactor As Double, rotationAngle As Double
	Dim imageName As String
	Dim rasterObj As AcadRasterImage

	imageName = "c:\program files\autocad\sample\watch.jpg"

	' Define Raster object
	insertionPoint(0) = 5: insertionPoint(1) = 5: insertionPoint(2) = 0
	scalefactor = 5#: rotationAngle = 0


	' Loads a raster image into model space
	Set rasterObj = ThisDrawing.ModelSpace.AddRaster(imageName, insertionPoint, scalefactor, rotationAngle)

	' Get the display preferences object
	Set ACADPref = ThisDrawing.Application.preferences.DISPLAY

	' Read and display the original value
	originalValue = ACADPref.TrueColorImages
	MsgBox "The TrueColorImages preference is set to: " & originalValue

	' Modify the TrueColorImages preference by toggling the value
	ACADPref.TrueColorImages = Not (originalValue)
	newValue = ACADPref.TrueColorImages
	ThisDrawing.Regen acAllViewports

	MsgBox "The TrueColorImages preference has been set to: " & newValue

	' Reset the preference back to it's original value
	' * Note: Comment out this last section to leave the change to
	'		 this preference in effect
	ACADPref.TrueColorImages = originalValue
	ThisDrawing.Regen acAllViewports

	MsgBox "The TrueColorImages preference was reset back to: " & originalValue

	Exit Sub

	' If you got an error (most likely a problem with the file path),
	' then display an error message
	If Err.Description <> "" Then
		MsgBox Err.Description
	End If
End Sub