Egg's Blog

C : Acad Customization

●Offset Tool 2

オフセットツールの更新

更新内容
　　　　　　　１、UCSに対応
　　　　　　　２、ネストした図形に対応
　　　　　　　　　（Line図形だけですけど...）

C : VBA

●コマンドラインでオプションの表示

Getpoint メソッドを利用して
座標 または　オプション文字を取得するには

InitializeUserInput メソッドで キーワードを作成
GetInput メソッドで入力された文字を取得します。

参考：AutoCADHelp　ActiveX/VBA 開発者用ガイド
「GetInput メソッド, GetInteger メソッドと使用」

'///////////////////////////////////////////////////////////////////////

Sub pointTest()

Dim pntA As Variant
Dim tempPnt(2) As Double
Dim initStr As String
Dim keyStr As String
Dim promptStr As String

    '点の定義
    tempPnt(0) = 10#: tempPnt(1) = 10#: tempPnt(2) = 10#

    'InitializeUserInputのキーワード
    keyStr = "U C"
   
    'コマンドプロンプト
    promptStr = "next point [元に戻す(U)/閉じる(C)]: "
   
    '点の取得
    pntA = anGetPnt(initStr, tempPnt, keyStr, promptStr)
   
    If IsEmpty(pntA) Then
        MsgBox initStr
    Else
        MsgBox pntA(0) & "," & pntA(1) & "," & pntA(2)
    End If
   
End Sub

'-----------------------------------------------------------

Function anGetPnt(ByRef gWord As String, beforPnt As Variant, keyWordStr As String, mesageStr As String) As Variant

On Error Resume Next

    'InitializeUserInput
    ThisDrawing.Utility.InitializeUserInput 2, keyWordStr
   
    '参照点の判別
    If IsEmpty(beforPnt) Then
    anGetPnt = ThisDrawing.Utility.GetPoint(, mesageStr)
    Else
    anGetPnt = ThisDrawing.Utility.GetPoint(beforPnt, mesageStr)
    End If
   
    If Err Then
        Select Case Err.Number
        Case -2147352567  'Esc
            gWord = "Esc"
           
        Case -2145320928  ' Put Keyboard
            '文字の取得
            gWord = ThisDrawing.Utility.GetInput
            If gWord = "" Then
                gWord = "Enter"
            End If
           
        Case Else
        End Select
        Err.Clear
    End If
End Function

C : angler

●サイズアップ　スズキさん

2006.01.28
場所：隅田川
時間：21:40
サイズ：640mm
ルアー：Rapara X-Rap SXR

いつもの場所で、
気分はちょっぴりS.E氏
トゥイッチに挑戦し Get！
まだまだぜんぜん初心者ですが、「食わせた」気になれました。
ルアーの楽しさを感じた瞬間でした。