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 On Error GoTo ERRORTRAP ' Loads a raster image into model space Set rasterObj = ThisDrawing.ModelSpace.AddRaster(imageName, insertionPoint, scalefactor, rotationAngle) ThisDrawing.Application.ZoomAll ' 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
ERRORTRAP: If Err.Description <> "" Then MsgBox Err.Description End If End Sub
Comments? |