AutoCAD VBA ColorIndex UserForm
Ver.1.01 (βバージョン) [2007/03/27]
AutoCAD ＶＢＡ用 インデックスカラー ダイアログ（ユーザーフォーム）です。
が・・・下記の 参考リンク先
で紹介されている方法がスマートです（笑）
もしくは、AutoLISP 照会関数 (acad_colordlg colornum [flag]) を使用する方法 もあります。
DownLoad (CI_UF101.lzh/18.6KB)
インデックスカラー ダイアログ （2000i 様式のユーザーフォーム）
・解凍したファイル "AutoCAD2000i_ColorIndex101.frm"を
インポート（読込）で、ご使用下さい
※インポート（読込）時には、"AutoCAD2000i_ColorIndex101.frx"も同じフォルダに
・2000iの様式でインデックスカラーのみ（配置が現バージョンと多少異なります）
・AutoCAD 2000i (VBA のバージョン 6) 以降
(注意)2000i 以外のバージョン (2000,R14.01,2002,2004,2005,2006,2007) では、動作確認していません
・フォームのロードに少し時間がかかります
・ColorIndex.I_C.Captionに、インデックス カラー (0-256)
・ColorIndex.R_G_B.Captionに、赤, 緑, 青(RGB) (xxx, xxx, xxx)
・キャンセル時は空欄 ("")
・理論色を使用しない場合には修正してください
上記の使用例（標準モジュール）です
|
Option Explicit
'
Public Sub GetIndexColor()
Dim MsgTmp As String
Load ColorIndex
''初期値を設定する場合
''CTextBox1_AfterUpdate をPublicに変更して
'ColorIndex.TextBox1.Value = "1" 'インデックス カラー (1-256)
'Call ColorIndex.TextBox1_AfterUpdate
ColorIndex.Show
MsgTmp = "" & vbCrLf
MsgTmp = MsgTmp & "インデックス カラー : " & ColorIndex.I_C.Caption & vbCrLf
MsgTmp = MsgTmp & "赤, 緑, 青(RGB) : " & ColorIndex.R_G_B.Caption & vbCrLf
MsgBox MsgTmp
Unload ColorIndex
End
End Sub
|
|
更新内容
[2007/03/27] Ver.1.01 Private Sub UserForm_QueryClose修正
[2007/03/26] Ver.1.00 新規公開
以前のバージョン
DownLoad (CI_UF100.lzh/18.6KB)
|
AutoLISP 照会関数 (acad_colordlg colornum [flag]) を使用する方法
|
|
Public Function AutoLISP_acad_colordlg_ByVBA(Colornum As Integer, Optional Flag As String = "nil", Optional USERSNo As Integer = 1) As Variant
'AutoCAD の標準の[色選択]ダイアログ ボックスを表示
' AutoLISP 照会関数 (acad_colordlg colornum [flag]) を使用
' 引数 Colornum [Integer] 整数 色番号(0-256) 既定値として表示される AutoCAD 色番号
' Flag [Variant/String] 省略可(規定値 1)
' nil に設定すると、[BYLAYER]と[BYBLOCK]ボタンが使用不可能になります。
' flag 引数を省略するか nil 以外の値を指定すると、
' [BYLAYER]と[BYBLOCK]ボタンが使用可能になります。
' USERSNo [Integer] 省略可(規定値 1)
' 戻値を格納するシステム変数のNo (1,2,3,4,5)
' 戻り値 正常終了 色番号(0-256) [Variant/Integer]
' ダイアログキャンセル時 -1 [Variant/Integer]
' 異常終了 Empty [Variant/Empty]
' その他 ダイアログキャンセル時の戻り値が"nil"となるため "USERS*" を使用する
Dim ComStr As String
Dim USERSname As String
On Error GoTo ERR:
If 0 <= Colornum And Colornum <= 256 Then
Select Case USERSNo
Case 1, 2, 3, 4, 5: USERSname = "USERS" & CStr(USERSNo)
Case Else: Exit Function
End Select
ActiveDocument.SetVariable USERSname, ""
ComStr = "" '送信するLISPコマンド作成
ComStr = ComStr & "(setvar """ & USERSname & """ " 'AutoCAD システム変数 "USERS?" に代入
ComStr = ComStr & "(vl-princ-to-string " 'LISP データを表す文字列を、princ 関数で出力したかのように返す
'------------------------------------------------------
ComStr = ComStr & "(acad_colordlg " & CStr(Colornum) 'AutoCAD の標準の[色選択]ダイアログ ボックスを表示
If Flag = "nil" Then
ComStr = ComStr & " nil)" '[BYLAYER]と[BYBLOCK]ボタン 使用不可
Else
ComStr = ComStr & " T)" '[BYLAYER]と[BYBLOCK]ボタン 使用可
End If
'------------------------------------------------------
ComStr = ComStr & ")" '
ComStr = ComStr & ")" & vbCr '
ActiveDocument.SendCommand ComStr
AutoLISP_acad_colordlg_ByVBA = ActiveDocument.GetVariable(USERSname)
If AutoLISP_acad_colordlg_ByVBA = "nil" Then
AutoLISP_acad_colordlg_ByVBA = -1
Else
AutoLISP_acad_colordlg_ByVBA = CInt(AutoLISP_acad_colordlg_ByVBA)
End If
Else
AutoLISP_acad_colordlg_ByVBA = Empty
End If
Exit Function
ERR:
Exit Function
End Function
|
| '使用例 |
Public Sub Test()
Dim Colornum As Variant
Colornum = AutoLISP_acad_colordlg_ByVBA(3, "nil", 1) '[BYLAYER]と[BYBLOCK]ボタン 使用不可
If IsEmpty(Colornum) Then
Msgbox "Empty"
ElseIf Colornum = -1 Then
MsgBox "キャンセル"
Else
MsgBox Colornum
End If
Colornum = AutoLISP_acad_colordlg_ByVBA(3, "T", 1) '[BYLAYER]と[BYBLOCK]ボタン 使用可
If IsEmpty(Colornum) Then
Msgbox "Empty"
ElseIf Colornum = -1 Then
MsgBox "キャンセル"
Else
MsgBox Colornum
End If
End Sub
|
|
|