Color Dialog in VBA

[KevinBarnett]

Greetings Gang,

Is there a way to call the color dialog in Acad 2005's VBA?

I am still using the VLAX class to call the dialog in lisp - I hope this isnt the only way.

TIA,

Kevin.

[Ed Jobe]

Here's two different methods.


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

Public Function AcadFileDialog(DlgTitle As String, _
Optional DefaultFile As String = "", _
Optional Ext As String = "*", _
Optional Flag As Integer = 0) As String
'calls the acad file dialog and returns
'the file name or a null string "" if cancelled
'for a list of available flags, see help for (getfiled).
Dim strFileName As String
'store current sysvar value
strFileName = ThisDrawing.GetVariable("USERS5")
'call color dialog
ThisDrawing.SendCommand ("(setq fn (getfiled """ & DlgTitle & _
""" """ & DefaultFile & """ """ & Ext & """ " & Flag & "))" & vbCr)
ThisDrawing.SendCommand ("(if (= fn nil)" & _
"(setvar ""USERS5"" """")" & _
"(setvar ""USERS5"" fn))" & vbCr)
AcadFileDialog = ThisDrawing.GetVariable("USERS5")
'reset sysvar
ThisDrawing.SetVariable "USERS5", strFileName
End Function

[branimirj]

Well, when I start macro it says:

'User-defined type not defined.'
'DIM vl As New VLAX'

Maybe I need to add Reference?
I'm using Civil3D 2007, WinXP SP2



Here's two different methods.


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

Public Function AcadFileDialog(DlgTitle As String, _
Optional DefaultFile As String = "", _
Optional Ext As String = "*", _
Optional Flag As Integer = 0) As String
'calls the acad file dialog and returns
'the file name or a null string "" if cancelled
'for a list of available flags, see help for (getfiled).
Dim strFileName As String
'store current sysvar value
strFileName = ThisDrawing.GetVariable("USERS5")
'call color dialog
ThisDrawing.SendCommand ("(setq fn (getfiled """ & DlgTitle & _
""" """ & DefaultFile & """ """ & Ext & """ " & Flag & "))" & vbCr)
ThisDrawing.SendCommand ("(if (= fn nil)" & _
"(setvar ""USERS5"" """")" & _
"(setvar ""USERS5"" fn))" & vbCr)
AcadFileDialog = ThisDrawing.GetVariable("USERS5")
'reset sysvar
ThisDrawing.SetVariable "USERS5", strFileName
End Function

[Ed Jobe]

Search this forum for "vlax.cls". Its a class that allows you to execute lisp from vba.

[branimirj]

Thanks!
Works fine!

Can You give me brief axplanation haw to call a lisp dialog
and retrieve data from it in VBA?

I sow the functions of VLAX but I'm new to Lisp.

[Ed Jobe]

Its much easier to use a vba form.

[branimirj]

Ok, I agree!

But, look of the form designed in VBA is poor against the look of the dcl dialog.
Dcl is more CAD-like.

[rkmcswain]

If you want to avoid using "SendCommand", try this.



Public Declare Function acedSetColorDialog Lib "acad.exe" (color As Long, ByVal bAllowMetaColor As Boolean, ByVal nCurLayerColor As Long) As Boolean

Sub example_usage()
On Error Resume Next
Dim blnMetaColor As Boolean
Dim lngCurClr As Long
Dim lngInitClr As Long
If acedSetColorDialog(lngInitClr, blnMetaColor, lngCurClr) Then
MsgBox lngInitClr
End If
End Sub

[Ed Jobe]

Dcl is more CAD-like.
I didn't know there was such a thing as "CAD-like". AutoCAD is a Windows program and vba uses Windows controls. You can design a dialog to look like dcl if you choose to.

Anyway, I haven't tried calling a dcl dialog directly from vba. It works on lisp reactors. So it would probably be simplest to have a lisp front-end to the dialog, i.e. instead of calling the dialog from vba, create a function that calls it and returns a value. Then you can call that function from vba. However,

[branimirj]

Cheers!

Well I'll try to explain what I meant by the CAD-like form.
There are rounded corners in the frame, while line and text are colored.
When you move the mouse near form object (CheckBox for example) it appears colored and so on (like rollover effect on web page).
In VBA forms there are no such stuff.

Background story of the idea is to use dlg instead of VBA forms.
In routine that I created in VBA (it was finished and works fine), there are a lot of user inputs and I spend lots of time to design well organized form.
For example when I take a look at the Plot Dialog, it has many information on it and they are still well organized. I think maybe I will achieve the same result by using dlg dialogs.

I can send You screens to see what I mean, if You are interested.

[Ed Jobe]

Well I'll try to explain what I meant by the CAD-like form.
There are rounded corners in the frame, while line and text are colored.
When you move the mouse near form object (CheckBox for example) it appears colored and so on (like rollover effect on web page).
In VBA forms there are no such stuff.

Have you looked at the properties for the form controls? While the default checkbox doesn't have a MouseOver event, it does have other mouse events. There are other controls available on the internet. Additionally, you can make your own with VB6.

As for the other properties you describe, check out the BorderStyle and SpecialEffect properties. You can make them look exactly like dcl boxes.

[Ed Jobe]

If you want to avoid using "SendCommand", try this.



Public Declare Function acedSetColorDialog Lib "acad.exe" (color As Long, ByVal bAllowMetaColor As Boolean, ByVal nCurLayerColor As Long) As Boolean

Sub example_usage()
On Error Resume Next
Dim blnMetaColor As Boolean
Dim lngCurClr As Long
Dim lngInitClr As Long
If acedSetColorDialog(lngInitClr, blnMetaColor, lngCurClr) Then
MsgBox lngInitClr
End If
End Sub


Update: For using with current AutoCAD, You need to add PtrSafe and change exe to accore.dll.

Public Declare PtrSafe Function acedSetColorDialog Lib "accore.dll" (color As Long, ByVal bAllowMetaColor As Boolean, ByVal nCurLayerColor As Long) As Boolean