VB6.0用掲示板の過去のログ(No.1)−VBレスキュー(花ちゃん)
[記事リスト] [新規投稿] [新着記事] [ワード検索] [過去ログ] [管理用]

投稿日： 2003/12/10(Wed) 02:42
投稿者： もし
Ｅメール：
ＵＲＬ：
タイトル： Re^5: 動作

> > 度々すいません。
> > VBで座標データをDXFファイル(表示させると三角形)から読込み、その座標上を点が移動するにはどうしたらよろしいでしょうか？タイマーを使用してintervalを変えれるようにです。
> > よろしくお願い致します。
> >
> > 下がDXFファイルから座標を読み込んで表示するコードです。
> >
> > Open FileName For Input As #1
> >         Do Until EOF(1)
> >             n = n + 1
> >             Line Input #1, DXF
> >            
> >             If DXF = "AcDbLine" Then
> >                 i = i + 1
> >                 Line Input #1, DXF
> >                 If DXF = " 10" Then
> >                     Line Input #1, DXF      '10
> >                     a(i, 1) = Val(DXF)      'X座標その１(DXFを数値型に変換し、a(i,1)に格納)
> >                     'MsgBox a(i, 1) & "です。"
> >                     Line Input #1, DXF      'X座標その１
> >                     Line Input #1, DXF      '20
> >                     a(i, 2) = Val(DXF)      'Y座標その１(DXFを数値型に変換し、a(i,2)に格納)
> >                     Line Input #1, DXF      'Y座標その１
> >                     Line Input #1, DXF      '30
> >                     Line Input #1, DXF      '0.0
> >                     Line Input #1, DXF      '11
> >                     a(i, 3) = Val(DXF)      'X座標その２(DXFを数値型に変換し、a(i,3)に格納)
> >                     Line Input #1, DXF      'X座標その２
> >                     Line Input #1, DXF      '21
> >                     a(i, 4) = Val(DXF)      'Y座標その２(DXFを数値型に変換し、a(i,4)に格納)
> >                
> >                 For i = 1 To n
> >                     Picture1.Line (a(i, 1), a(i, 2))-(a(i, 3), a(i, 4)), 5
> >                 Next i
> >                
> >                 End If
>
> こんな感じで如何でしょうか？
>
> '(*frm) フォームにTimerを１つ,CommandButtonを２つ追加してください。
> Option Explicit
>
> '座標記憶用構造体
> Private Type ptyp座標
>     X1          As Single
>     Y1          As Single
>     X2          As Single
>     Y2          As Single
>     IncrementX  As Single   '増分
>     IncrementY  As Single   '増分
> End Type
>
> Private Const TIMER_INTERVAL = 100  'インターバル(ms)
>
> Private pt座標() As ptyp座標        '座標保持用
>
> Private Sub Form_Load()
>     Dim ii  As Integer
>    
>     'フォームの初期設定
>     With Me
>         .Height = 4725
>         .Width = 4170
>     End With
>    
>     'タイマーの初期設定
>     With Timer1
>         .Enabled = False
>         .Interval = TIMER_INTERVAL
>     End With
>    
>     'ボタン1の初期設定
>     With Command1
>         .Font.Name = "ＭＳ Ｐゴシック"
>         .Font.Size = 9
>         .Caption = "開始"
>         .Height = 300
>         .Width = 600
>         .Top = 4000
>         .Left = 15
>     End With
>    
>     'ボタン2の初期設定
>     With Command2
>         .Font.Name = "ＭＳ Ｐゴシック"
>         .Font.Size = 9
>         .Caption = "停止"
>         .Height = 300
>         .Width = 600
>         .Top = 4000
>         .Left = 630
>     End With
>    
>     'デモデータ作成
>    
>     ReDim pt座標(3)
>    
>     With pt座標(1)
>         .X1 = 500
>         .Y1 = 3500
>         .X2 = 2000
>         .Y2 = 500
>         .IncrementX = -(.X1 - .X2) / 100    '増分
>         .IncrementY = -(.Y1 - .Y2) / 100    '増分
>     End With
>
>     With pt座標(2)
>         .X1 = 2000
>         .Y1 = 500
>         .X2 = 3500
>         .Y2 = 3500
>         .IncrementX = -(.X1 - .X2) / 100    '増分
>         .IncrementY = -(.Y1 - .Y2) / 100    '増分
>     End With
>    
>     With pt座標(3)
>         .X1 = 3500
>         .Y1 = 3500
>         .X2 = 500
>         .Y2 = 3500
>         .IncrementX = -(.X1 - .X2) / 100    '増分
>         .IncrementY = -(.Y1 - .Y2) / 100    '増分
>     End With
>    
> '    'ファイルから読み込ます場合は下記のようになります。
> '　　'条件等はそちらでコーディングしてください。
> '
> '    Dim iFreeFile   As Integer
> '    Dim sFileName   As String
> '    Dim sTmp        As String
> '
> '    ReDim pt座標(0)
> '
> '    sFileName = "C:\xxxx.dxf"
> '
> '    iFreeFile = FreeFile()
> '
> '    Open sFileName For Input As #1
> '
> '    Do While Not EOF(iFreeFile)
> '
> '        '読み込む
> '        Line Input #iFreeFile, sTmp
> '
> '        '配列を増やす
> '        ReDim Preserve pt座標(UBound(pt座標) + 1)
> '
> '        '座標情報設定
> '        With pt座標(UBound(pt座標))
> '            .X1 = sTmp
> '            .Y1 = sTmp
> '            .X2 = sTmp
> '            .Y2 = sTmp
> '            .IncrementX = -(.X1 - .X2) / 100    '増分
> '            .IncrementY = -(.Y1 - .Y2) / 100    '増分
> '        End With
> '
> '    Loop
>    
> End Sub
>
> Private Sub Command1_Click()
>     '開始
>     Timer1.Enabled = True
> End Sub
>
> Private Sub Command2_Click()
>     '停止
>     Timer1.Enabled = False
> End Sub
>
> Private Sub Timer1_Timer()
>     Dim ii          As Integer
>     Static iIndex   As Integer  'インデックス保持用
>     Static X        As Single   '円のX座標保持用
>     Static Y        As Single   '円のY座標保持用
>    
>     'ファイルからデータが読み込めなかった時の事を考慮して
>     If UBound(pt座標) = 0 Then
>         Timer1.Enabled = False
>         Exit Sub
>     End If
>    
>     Me.Cls
>    
>     DoEvents
>    
>     For ii = 1 To UBound(pt座標)
>         With pt座標(ii)
>             Line (.X1, .Y1)-(.X2, .Y2), 5
>         End With
>     Next ii
>    
>     '次に表示する円の座標を取得し表示する
>     If psbGetCoordinate(X, Y, iIndex) Then
>         Circle (X, Y), 100
>     End If
>      
> End Sub
>
> '--------------------------------------------------------
> '概要      :座標取得
> 'パラメータ    :変数名        ,IO  ,型        ,説明
> '          :X 　　　 　   ,I/O ,Single    ,X座標
> '          :Y 　　　 　   ,I/O ,Single    ,Y座標
> '          :iIndex　 　   ,I/O ,Single    ,配列番号
> '          :戻り値        ,O   ,Boolean   ,True:正常 / False:異常
> '説明      :次に表示する円の座標を取得する
> '--------------------------------------------------------
> Private Function psbGetCoordinate(ByRef X As Single, ByRef Y As Single, ByRef iIndex As Integer) As Boolean
>     Dim iTmp    As Integer
>    
>     psbGetCoordinate = False
>    
>     If iIndex = 0 Then
>         If UBound(pt座標) = 0 Then
>             Exit Function
>         Else
>             iIndex = 1
>             X = pt座標(iIndex).X1
>             Y = pt座標(iIndex).Y1
>         End If
>     End If
>    
>     With pt座標(iIndex)
>        
>         X = X + .IncrementX
>         Y = Y + .IncrementY
>        
>         iTmp = iIndex
>        
>         If .IncrementX < 0 Then
>             If X < .X2 Then
>                 iTmp = iIndex + 1
>             End If
>         Else
>             If X > .X2 Then
>                 iTmp = iIndex + 1
>             End If
>         End If
>        
>         If iTmp <> iIndex Then
>            
>             If iTmp > UBound(pt座標) Then
>                 iIndex = 1
>             Else
>                 iIndex = iTmp
>             End If
>            
>             X = pt座標(iIndex).X1
>             Y = pt座標(iIndex).Y1
>        
>         End If
>        
>     End With
>
>     psbGetCoordinate = True
>
> End Function

ありがとうございます。やってみます。ご丁寧に感謝します。

- 関連一覧ツリー （★ をクリックするとツリー全体を一括表示します）
- 返信フォーム （この記事に返信する場合は下記フォームから投稿して下さい）

- Web Forum -