VBA中的AutoCAD真彩色对话框？
我有这个代码，我通过使用aced. h中定义的原始命令将其移植到VBA。类型似乎是正确的，除非当然我错过了一些非常巨大的东西。这些努力总是给AutoCAD带来致命的错误...当然，我知道这不是首选方法，但我真的很想拥有这个颜色对话框界面。这是代码
' 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
我已经看到许多其他人也会喜欢这个功能的地方，所以如果它能准确完成，那将是一件好事。
**** Hidden Message ***** 我在这里没有看到objPtr，但无论我尝试什么，我都崩溃了。
Keith，顺便说一句，
如果api暴露给C++它是否一定暴露给其他程序。
基思；
我知道你会说俄语，也会读俄语，所以也许你会在这里找到一些有用的东西：
http://www.autocad.ru/cgi-bin/f1/board.cgi?t=4258zJ
HTH
Luis，
这似乎不起作用。至少在2007年。我更改了类型并以多种方式调整了调用，最终结果总是一个致命的错误。
是的，我尝试了用我对VBA的一点知识…并且得到了致命错误
如果您使用例如C#，它非常简单…
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());
}
路易斯，我开始认为错误是由于VBA和AutoCAD之间的数据类型的转换。你认为有可能建立一个我可以在VBA引用和调用的activex dll吗？
可能是......关于activex，我从来没有做过...
这是其他人使用Frank O.类调用lisp函数所做的，可能会有所帮助（您可能知道）......
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
基思;
我把这个代码给了一个朋友，用A2006进行测试，并工作，但在A2008上崩溃了。我在A2007和A2005中测试了这里，并得到了漂亮的崩溃
只是一个小小的改变：
AllowMetaColor As Boolean
被制作出来了....
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
谢谢Luis，
有了Frank Oquendo的VLAX课程，这在2007年对我来说就像是一次穿梭
不客气！
页:
[1]
2