投稿時間：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
ありがとうございます。やってみます。ご丁寧に感謝します。
|