範囲選択した真円を線種、線色、半径を
指定して(AND条件)別の線種、線色、半径に
変更する外変です。
VisualBasic6のランタイムが必要です。
折角なので以前作ったものですがVisualBaic6のソースも貼っておきます。
ExeleのVBAととても似ていると思います。
昔つくったのでプログラムとしてはあまりに・・・という部分はありますが
ご容赦ください。
まず batファイルです
rem 丸の半径を選択変更
echo off
rem #jw
rem #cd
rem #h1
rem #hc
rem #e
丸変更.exe
ソースになります
Dim curLt
Dim curLc
Private Sub Command1_Click()
dumFile = FreeFile
Open CurDir & "\dumy.txt" For Output As dumFile
Close dumFile
dumFile = FreeFile
Open CurDir & "\dumy.txt" For Append As dumFile
Print #dumFile, "hd"
Close dumFile
FileNum = FreeFile
Open CurDir & "\JWC_TEMP.TXT" For Input As FileNum
Do Until EOF(FileNum)
Line Input #FileNum, NextLine
OneWord = ""
c = 1
Do
OneSt = Mid(NextLine, c, 1)
If OneSt = "" Then Exit Do
If OneSt = " " Then
Exit Do
Else
OneWord = OneWord & OneSt
End If
c = c + 1
Loop
Call getElement(OneWord, NextLine)
Loop
Close FileNum
FileNum = FreeFile
Open CurDir & "\JWC_TEMP.TXT" For Output As FileNum
Print #FileNum, ""
Close FileNum
dumFile = FreeFile
Open CurDir & "\dumy.txt" For Input As dumFile
FileNum = FreeFile
Open CurDir & "\JWC_TEMP.TXT" For Output As FileNum
Do Until EOF(dumFile)
Line Input #dumFile, NextLine
Print #FileNum, NextLine
Loop
Close dumFile
Close FileNum
End
End Sub
Private Sub getElementProp(OneWord, NextLine)
Select Case Mid(OneWord, 1, 2)
Case "lt" '線種
curLt = CInt(Mid(OneWord, 3))
Case "lc" '線色'
curLc = CInt(Mid(OneWord, 3))
End Select
End Sub
Private Function 選択色()
Select Case cb選択線色
Case "線色 1": 選択色 = 1
Case "線色 2": 選択色 = 2
Case "線色 3": 選択色 = 3
Case "線色 4": 選択色 = 4
Case "線色 5": 選択色 = 5
Case "線色 6": 選択色 = 6
Case "線色 7": 選択色 = 7
Case "線色 8": 選択色 = 8
Case "補助線色": 選択色 = 9
Case Else: 選択色 = ""
End Select
End Function
Private Function 選択種()
Select Case cb選択線種
Case "実線": 選択種 = 1
Case "点線1": 選択種 = 2
Case "点線2": 選択種 = 3
Case "一点鎖1": 選択種 = 4
Case "一点鎖2": 選択種 = 5
Case "二点鎖1": 選択種 = 6
Case "二点鎖2": 選択種 = 7
Case Else: 選択種 = ""
End Select
End Function
Private Function 変更色()
Select Case cb変更線色
Case "線色 1": 変更色 = 1
Case "線色 2": 変更色 = 2
Case "線色 3": 変更色 = 3
Case "線色 4": 変更色 = 4
Case "線色 5": 変更色 = 5
Case "線色 6": 変更色 = 6
Case "線色 7": 変更色 = 7
Case "線色 8": 変更色 = 8
Case "補助線色": 変更色 = 9
Case Else: 変更色 = ""
End Select
End Function
Private Function 変更種()
Select Case cb変更線種
Case "実線": 変更種 = 1
Case "点線1": 変更種 = 2
Case "点線2": 変更種 = 3
Case "一点鎖1": 変更種 = 4
Case "一点鎖2": 変更種 = 5
Case "二点鎖1": 変更種 = 6
Case "二点鎖2": 変更種 = 7
Case Else: 変更種 = ""
End Select
End Function
Private Function IsOne(R) As Boolean
IsOne = False
If Text1(0) = "" Then
IsOne = True
Else
If R = Text1(0) Then
IsOne = True
Else
IsOne = False
End If
End If
If IsOne = True Then
If 選択色 = "" Then
IsOne = True
Else
If curLc = 選択色 Then
IsOne = True
Else
IsOne = False
End If
End If
End If
If IsOne = True Then
If 選択種 = "" Then
IsOne = True
Else
If curLt = 選択種 Then
IsOne = True
Else
IsOne = False
End If
End If
End If
End Function
Private Sub getElement(OneWord, NextLine)
c = 0
dumFile = FreeFile
Open CurDir & "\dumy.txt" For Append As dumFile
Select Case OneWord
Case "hq" '実行チェック文字
Case "ci"
c = 1
ci = GetWord(NextLine, c)
cX = GetWord(NextLine, c)
cY = GetWord(NextLine, c)
R = GetWord(NextLine, c)
dum = GetWord(NextLine, c)
If IsEmpty(dum) Then
If IsOne(R) Then
If 変更色 = "" Then
Else
Print #dumFile, "lc" & 変更色
End If
If 変更種 = "" Then
Else
Print #dumFile, "lt" & 変更種
End If
If Text1(1) = "" Then
Else
R = Text1(1)
End If
Print #dumFile, ci & " " & cX & " " & cY & " " & R
Print #dumFile, "lc" & curLc
Print #dumFile, "lt" & curLt
Else
Print #dumFile, NextLine
End If
Else
Print #dumFile, NextLine
End If
Case Else
Print #dumFile, NextLine
Call getElementProp(OneWord, NextLine)
End Select
Close dumFile
End Sub
Public Function GetWord(NextLine, c)
If c = 0 Then c = 1
Do
OneSt = Mid(NextLine, c, 1)
If OneSt = "" Then Exit Function
If OneSt = "," Or OneSt = " " Then
Exit Do
Else
GetWord = GetWord & OneSt
End If
c = c + 1
Loop
cNext = c
For i = cNext To Len(NextLine)
If Mid(NextLine, i, 1) = " " Or Mid(NextLine, i, 1) = "," Then
c = c + 1
Else
Exit Function
End If
Next i
End Function