Topic: AutoCAD True Color dialog in VBA?

[Keith™]

I have this code that I ported to VBA by using the original command as defined in aced.h The types seem to be correct, unless of course I am missing something really huge. The efforts always bring AutoCAD to a fatal error .. of course, I know this is not the preferred method, but I really would like to have this color dialog interface.

Here is the code

Code: [Select]

' This is the definition of acedSetColorDialogTrueColor as found in aced.h
' acedSetColorDialogTrueColor(
'    AcCmColor& color,
'    Adesk::Boolean bAllowMetaColor,
'    const AcCmColor& curLayerColor,
'    AcCm::DialogTabs tabs = (AcCm::DialogTabs)(AcCm::kACITab | AcCm::kTrueColorTab| AcCm::kColorBookTab));
'
'   My understanding is that AcCmColor& is a pointer to the AcCmColor object(AcadAcCmColor in VBA)
'   Constants are directly from aced.h

Private Declare Function acedSetColorDialogTrueColor Lib "acad.exe" (ByVal pColor As Long, _
ByVal bAllowMetaColor As Boolean, ByVal pCurLayerColor As Long, ByVal DialogTabs As Integer) As Boolean

Private Const kACITab = 1
Private Const kTrueColorTab = 2
Private Const kColorBookTab = 4

Public Function GetAcadTrueColor(MtaCol As Boolean) As Object
  Dim SelectColor As AcadAcCmColor 'This is returned from the call
  Dim LayColor As New AcadAcCmColor ' This is sent to the call, thus I initialize it first without regard to the color

  On Error Resume Next
  If acedSetColorDialogTrueColor(ObjPtr(SelectColor), MtaCol, ObjPtr(LayColor), kACITab Or kTrueColorTab Or kColorBookTab) Then
    Set GetAcadTrueColor = SelectColor 'return AcadAcCmColor
  End If
End Function

I have seen where many other people would like this functionality as well, so it would be a good thing if it could be completed accurately.

[Bryco]

I dont see objPtr here but I crashed no matter what I tried.
Keith, on a side note
if an api is exposed to C++ is it necessarily exposed to other programs.

[LE]

Keith;

I know you speak and read Russian, so maybe you will find something useful here:

http://www.autocad.ru/cgi-bin/f1/board.cgi?t=4258zJ


HTH

[Keith™]

Luis,
It doesn't seem to work .. at least on 2007 .. I changed the types and adjusted the call in several ways, the end result is always a fatal error.

[LE]

Yes, I tried with my very little knowledge of VBA.... and was getting the fatal error

If you use for example C# it is very simple...

Code: [Select]

[CommandMethod("COLORDLG")]
public void colordlg()
{
    Document doc = acadApp.DocumentManager.MdiActiveDocument;
    Editor ed = doc.Editor;

    ColorDialog dlg = new ColorDialog();
    if (dlg.ShowDialog() != System.Windows.Forms.DialogResult.OK) return;

    Autodesk.AutoCAD.Colors.Color clr = dlg.Color;
    ed.WriteMessage("\nColor selected is [{0}]", clr.ToString());
}


[Keith™]

Luis, I am beginning to think the error is because of a translation of the data types between VBA and AutoCAD. Do you think it would be possible to build an activex dll that I could reference and invoke in VBA?

[LE]

Luis, I am beginning to think the error is because of a translation of the data types between VBA and AutoCAD. Do you think it would be possible to build an activex dll that I could reference and invoke in VBA?

Might be.... and about activex I never have done one...


Here is what others have done to call lisp function using Frank O. class, might help (you probably know about it)....

Code: [Select]

Public Function AcadColorDialog() As Integer
    'calls the acad color dialog and returns
    'the index of the color selected or -1 if cancelled
    Dim i As Integer
    Dim vl As New VLAX
   
    'call color dialog
    vl.EvalLispExpression ("(setq clr (acad_colordlg 1))")
    'if dialog was canceled, clr will be nil, set to -1 instead
    i = vl.EvalLispExpression("(if (= clr nil)(setq clr -1)(setq clr clr))")
    AcadColorDialog = i
    Set vl = Nothing
End Function


[LE]

Keith;

I gave this code to a friend to run a test with A2006 and works but crash on A2008.... I tested here in A2007 and A2005 and get the nice crash


Just a minor change on:

AllowMetaColor As Boolean

was made....

Code: [Select]

Option Explicit

Type tColor
   NotKnow As Long
   Color As Long
   ColorName As Long
   ColorBook As Long
End Type

Private Declare Function acedSetColorDialogTrueColor Lib "acad.exe" _
  (ByRef Color As tColor, ByVal AllowMetaColor As Boolean, _
   ColorCurrent As tColor, ByVal ColorSystems As Byte) As Byte

Sub DlgTrueColor()
Dim Color As AcadAcCmColor
Dim AllowMetaColor As Boolean
Dim ColorSystems As Byte
Dim Result As Byte
Dim ColorOld As Long
Dim ColorLong As tColor, ColorCurrent As tColor
   With ColorLong
      .NotKnow = 1691390208
      .Color = -1024366560
      .ColorName = 0
      .ColorBook = 0
End With
   With ColorCurrent
      .NotKnow = 1691390208
      .Color = -1023410169
      .ColorName = 0
      .ColorBook = 0
   End With
   AllowMetaColor = True
   ColorSystems = 7
   On Error Resume Next
   ColorOld = ColorLong.Color
   Result = acedSetColorDialogTrueColor(ColorLong, AllowMetaColor, ColorCurrent, ColorSystems)

 On Error GoTo 0
   If ColorLong.Color = ColorOld Then
      MsgBox "!", vbExclamation
    Else
      Set Color = Application.GetInterfaceObject("AutoCAD.AcCmColor.16")
      Color.EntityColor = ColorLong.Color
      If Color.ColorMethod = acColorMethodByRGB Then
         MsgBox ": " & Chr(13) & Chr(10) & _
           "   : RGB — " & Color.ColorMethod & Chr(13) & Chr(10) & _
           "   : R" & Color.Red & ":G" & Color.Green & ":B" & Color.Blue, vbInformation
       Else
         MsgBox ": " & Chr(13) & Chr(10) & _
           "   : ACI — " & Color.ColorMethod & Chr(13) & Chr(10) & _
           "   : " & Color.ColorIndex, vbInformation
      End If
   End If
End Sub


[Fatty]

Here is what others have done to call lisp function using Frank O. class, might help (you probably know about it)....

Thanks Luis,

With Frank Oquendo's VLAX class this worked like a
shuttle for me in A2007eng

Cheers

~'J'~

[LE]

Thanks Luis,

With Frank Oquendo's VLAX class this worked like a
shuttle for me in A2007eng

Cheers

~'J'~

You are welcome!

[Kerry]

Keith;

I gave this code to a friend to run a test with A2006 and works but crash on A2008.... I tested here in A2007 and A2005 and get the nice crash

could it be this ??
Set Color = Application.GetInterfaceObject("AutoCAD.AcCmColor.16")

[LE]

could it be this ??
Set Color = Application.GetInterfaceObject("AutoCAD.AcCmColor.16")

Nope.... 

To bad I do not have AutoCAD 2006 to test the code.

[Keith™]

The object changes according to the version of AutoCAD, in 2005-2006 it is AutoCAD.AcCmColor.16, in 2007 and 2008 it is AutoCAD.AcCmColor.17, but it doesn't make any difference, at least not in the code posted.

Returning the color values shouldn't be a problem, even if you don't utilize AcCmColor.xx to create a color structure, in all of my tests the failure was during the call to show the color dialog.