VB6.0用掲示板の過去のログ(No.1)−VBレスキュー(花ちゃん)
[記事リスト]
[新規投稿]
[新着記事]
[ワード検索]
[過去ログ]
[管理用]
> 度々すいません。
> 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
- 関連一覧ツリー
（★ をクリックするとツリー全体を一括表示します）
★ - 動作 - もし 12/07-04:04No.6939
- Re: 動作 - AK 12/08-15:13 No.6947
- 返信フォーム
（この記事に返信する場合は下記フォームから投稿して下さい）