用户登陆
站点日历
站点统计
最新评论
VBA 调用AutoCAD “选择颜色对话框" [ 日期：2009-02-17 ] [ 来自：
'声明
Private Declare Function acedSetColorDialog Lib "acad.exe" _
(Color As Long, ByVal bAllowMetaColor As Boolean, ByVal nCurLayerColor As Long) As Boolean
'封装API函数，获得用户选择颜色的结果
Public Function GetColorFromDlg(ByVal initColor As Long, _
ByVal bAllowMetaColor As Boolean, ByVal nCurLayerColor As Long) As Long
GetColorFromDlg = -1
On Error Resume Next
If acedSetColorDialog(initColor, bAllowMetaColor, nCurLayerColor) Then
GetColorFromDlg = initColor
End If
End Function
Sub DrawLine()
Dim Color As New AcadAcCmColor '注意定义方法
Color.ColorIndex = GetColorFromDlg(1, False, 256)
Dim L As AcadLine
Dim P1(2) As Double
Dim P2(2) As Double
P1(0) = 0: P1(1) = 0: P1(2) = 0
P2(0) = 100: P2(1) = 100: P2(2) = 0
Set L = ThisDrawing.ModelSpace.AddLine(P1, P2)
L.Color = Color.ColorIndex
End Sub
Private Declare Function acedSetColorDialog Lib "acad.exe" _
(Color As Long, ByVal bAllowMetaColor As Boolean, ByVal nCurLayerColor As Long) As Boolean
'封装API函数，获得用户选择颜色的结果
Public Function GetColorFromDlg(ByVal initColor As Long, _
ByVal bAllowMetaColor As Boolean, ByVal nCurLayerColor As Long) As Long
GetColorFromDlg = -1
On Error Resume Next
If acedSetColorDialog(initColor, bAllowMetaColor, nCurLayerColor) Then
GetColorFromDlg = initColor
End If
End Function
Sub DrawLine()
Dim Color As New AcadAcCmColor '注意定义方法
Color.ColorIndex = GetColorFromDlg(1, False, 256)
Dim L As AcadLine
Dim P1(2) As Double
Dim P2(2) As Double
P1(0) = 0: P1(1) = 0: P1(2) = 0
P2(0) = 100: P2(1) = 100: P2(2) = 0
Set L = ThisDrawing.ModelSpace.AddLine(P1, P2)
L.Color = Color.ColorIndex
End Sub
[本日志由 tiancao1001 于 2009-02-17 07:49 PM 编辑]
|
|
你好，我试了一下，在vb6中还真的不好用。
谢谢版主，但我指的是在VISUAL BASIC 6里面调用AutoCAD “选择颜色对话框，能生成EXE后缀的那一种，不是直接在CAD里面的VB上编程。
上面的代码不是就是调用cad选择颜色对话框的吗？？
请问在VB6中怎样调用AutoCAD “选择颜色对话框
| 发表评论 - 不要忘了输入验证码哦！ |