I need your help with the coordinates. What I would like to happen is to print an "X" after the given coordinates. Example: The given coordinates for x-axis is 2 and y-axis is 2
the output will be:
So basically, 2 "#" on the top and 2 "#" on the left, then it will print the letter "X"
Dim d As String = ""
For i = 0 To NumericUpDownX.Value
For j = 0 To NumericUpDownY.Value
d = d & "#"
Next
d = d & vbNewLine
Next
output.Text = d
I was able to print the # but I can't seem to figure out how to put the "X" there.
I'd do it like this with the String constructor and PadLeft:
Dim d As New System.Text.StringBuilder
For y = 0 To NumericUpDownY.Value
If y < NumericUpDownY.Value Then
d.AppendLine(New String("#", NumericUpDownX.Value + 1))
Else
d.AppendLine("X".PadLeft(NumericUpDownX.Value + 1, "#"))
End If
Next
output.Text = d.ToString
If you want something more inline with what you were originally doing, then:
Dim d As String = ""
For y = 0 To NumericUpDownY.Value
For x = 0 To NumericUpDownX.Value
If y = NumericUpDownY.Value AndAlso x = NumericUpDownX.Value Then
d = d & "X"
Else
d = d & "#"
End If
Next
d = d & vbCrLf
Next
output.Text = d
Related
I am developing a script to divide the number of files in a folder into four groups. These will be turned into four batch files but for now the issue is dividing them up as evenly as possible.
The script below will work somewhat - if I have a Count that will be divided by 4 evenly but if I have an odd number, no go and less than four will crash. You can run the script just replace the "C:\1_SourceData\Section_16\" with your own path of files. If you un-comment the section 'Add remainder to front', it was to thow any extra files, like an odd number, to the first batch but that does not quite work. The number of files in the folder will range from 1 to 25.
Any help would be most appreciated.
Option Explicit
Dim fileList : Set fileList = GetFileList("C:\1_SourceData\Section_16\")
Dim NumOfFiles : NumOfFiles = fileList.Count - 1
Dim modNumber : modNumber = NumOfFiles/4
Dim remainder : remainder = NumOfFiles Mod modNumber
Dim string1 : string1 = "batch" & batchCounter
Dim string2 : string2 = ""
'Add remainder to front
'Dim i : i = 0
'For i = NumOfFiles - remainder To NumOfFiles
' string2 = string2 & vbTab & fileList(i) & vbNewLine
'Next
Dim batchCounter : batchCounter = 1
Dim file
Dim j : j = 0
For Each file In fileList
string2 = string2 & vbTab & file & vbNewLine
j = j + 1
If j Mod modNumber = 0 Then
WScript.Echo string1 & vbNewLine & string2
batchCounter = batchCounter + 1
string1 = "batch" & batchCounter
string2 = ""
End If
Next
Public Function GetFileList(path)
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim fileList : Set fileList = CreateObject("System.Collections.ArrayList")
Dim InfFolder : Set InfFolder = objFSO.GetFolder(path)
Dim File
For Each File In objFSO.GetFolder(path).Files
fileList.Add File
Next Set GetFileList = fileList
End Function
The problem is: the .Files collection is accessible via For Each only. A 'distribution by number' (think modulo) needs an extra counter. Demo script:
Option Explicit
ReDim a(3) ' 4 groups/collections
Dim i
For i = 0 To UBound(a)
Set a(i) = CreateObject("System.Collections.ArrayList")
Next
i = 0
Dim f
' fake a list of elms accessible via For Each only
For Each f In Split("a b c d e f g h i j k l m n")
a(i Mod 4).Add f ' use Mod to determine the 'bucket'
i = i + 1 ' counter needed for Mod
Next
For i = 0 To UBound(a)
WScript.Echo i, Join(a(i).ToArray())
Next
output:
cscript 40639293.vbs
0 a e i m
1 b f j n
2 c g k
3 d h l
You could structure your loop differently.
There are F files that should be devided into B batches of X files each. Two things can happen:
F is an exact multiple of B, in which case X = F / B
F is not an exact multiple of B, in which case X = (F / B) + 1
Therefore we can write two loops that (together) count from 1 to F:
Option Explicit
Const BATCHES = 4
Const PATH = "C:\1_SourceData\Section_16"
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
Dim fileList : Set fileList = GetFileList(PATH)
Dim b, i, f, x
f = fileList.Count
x = CInt(f / BATCHES)
If x * BATCHES < f Then x = x + 1
For b = 0 To BATCHES - 1
If (b * x < f) Then WScript.Echo "batch" & (b + 1)
For i = b * x To (b + 1) * x - 1
If (i < f) Then WScript.Echo vbTab & fileList(i)
Next
Next
Function GetFileList(path)
Dim file
Set GetFileList = CreateObject("System.Collections.ArrayList")
For Each file In FSO.GetFolder(path).Files
GetFileList.Add File
Next
End Function
I want to make a line rotate. I studied the pi and radians and I made my own algorithm (if I can call it like that). I don't like to use already-made code from the Internet. I want to discover them alone, but using logic. Here is the code:
Dim pi As Double
Dim a, b, c, d, e, x, y As Double
Dim speed, radius As Integer
Private Sub Form_Load()
pi = 3.14159265358979
speed = 1
radius = 600
End Sub
Private Sub Command1_Click()
Timer1.Enabled = Not Timer1.Enabled
If Timer1.Enabled = True Then
Command1.Caption = "Stop"
Else
Command1.Caption = "Start"
End If
End Sub
Private Sub Timer1_Timer()
ForeColor = vbWhite
timer1.interval=speed
Refresh
a = a + 2
b = Sin((a * pi) / 180)
c = Cos((a * pi) / 180)
y = radius * b
x = radius * c
Call Label1.Move(6240 + x, 4200 + y)
If Left(b, 1) = "-" Then
Label1.Caption = "---"
Else
Label1.Caption = "+++"
End If
If Left(c, 1) = "-" Then
Label1.Caption = Label1.Caption & " " & "---"
Else
Label1.Caption = Label1.Caption & " " & "+++"
End If
Line (3000 + x, 4200 + y)-(6240 + x, 4200 + y)
Line (3000, 4200)-(3000 + x, 4200 + y)
Line (6240, 4200)-(6240 + x, 4200 + y)
For d = 3000 To 6240
Line (d, 4200)-(3000 + x, 4200 + y)
Next
For e = 3000 + x To 6240 + x
Line (e, 4200 + y)-(6240, 4200)
Next
End Sub
I want to rotate the line on x-axis, not z (it appears to be z). I recalculated everything, but I don't see where is the problem. What would be an explained formula?
I believe you are after the following effect:
Option Explicit
Dim D As Long, S As Long, Y As Long
Private Sub Command1_Click()
Timer1.Enabled = Not Timer1.Enabled
If Timer1.Enabled = True Then
Command1.Caption = "Stop"
Else
Command1.Caption = "Start"
End If
End Sub
Private Sub Form_Load()
D = 1 'Start going down; change to 0 to start going up instead
Y = 100 'Mid point
End Sub
Private Sub Timer1_Timer()
If S Then
If S = 8 Then
S = 0
Else
S = S + 1
lblRate = "0"
Exit Sub
End If
End If
Refresh
If D Then
If Y < 200 Then
Select Case Y
Case Is < 20
'Begin to accelerate
Y = Y + 1
lblRate = "+1"
Case Is < 40
'Continue to accelerate
Y = Y + 2
lblRate = "+2"
Case Is < 160
'Set acceleration to peak
Y = Y + 3
lblRate = "+3"
Case Is < 180
'Begin to decelerate
Y = Y + 2
lblRate = "+2"
Case Else
'Continue to decelerate
Y = Y + 1
lblRate = "+1"
End Select
Else
'Stop and reverse direction
D = 0
S = 1
lblRate = "0"
End If
Else
If Y > 0 Then
Select Case Y
Case Is < 20
'Begin to accelerate
Y = Y - 1
lblRate = "-1"
Case Is < 40
'Continue to accelerate
Y = Y - 2
lblRate = "-2"
Case Is < 160
'Set acceleration to peak
Y = Y - 3
lblRate = "-3"
Case Is < 180
'Begin to decelerate
Y = Y - 2
lblRate = "-2"
Case Else
'Continue to decelerate
Y = Y - 1
lblRate = "-1"
End Select
Else
'Stop and reverse direction
D = 1
S = 1
End If
End If
Line (120, 100)-(120, Y)
End Sub
While not technically following a properly calculated curvature, it is more of a simplified version of a line rotating around the X-axis.
Also, make sure to use the Pixel scale mode, rather than Twips, for better drawing performance.
I am trying to use the following code to fill a list box with tag values. In the for loop I create the tag to insert into the list box. My question is how do I pad the tag name number with zeros? For example ValveName001 - ValveName120?
Dim i, listbox1, listbox2, tag
Set listbox1 = ScreenItems("ListBoxValveName")
For i = 1 To 120
tag = "ValveName" & "##" & i & ""
listbox1.SelectedIndex = i
Set listbox1.SelectedText = SmartTags.Item(tag)
Next
tag = "ValveName" & Right("00" & i, 3)
Include the padding and get only the needed characters
Or invest in a more generally applicable (and safer) function. To get you started:
Option Explicit
' pad (stringable) value v on the left to width w using fill character f
Function padLeft(v, w, f)
If Len(v) < w Then
padLeft = Right(String(w, f) & v, w)
Else
padLeft = v
End If
End Function
Dim v : v = "1"
Dim w : w = 3
Dim f : f = "0"
WScript.Echo v, w, f, padLeft(v, w, f)
output:
cscript 26163030.vbs
1 3 0 001
Improved function (stolen from #Bond's comment):
Function padLeft(v, w, f)
Dim l : l = Len(v)
If l < w Then
padLeft = String(w - l, f) & v
Else
padLeft = v
End If
End Function
I have this string:
0|1|2|3|4|5|6|7|8|9
I need to return the text after the 6th occurence of | and before the 7th. In this example, it would be 6.
Can his be achieved using the simple String functions (Mid, Left, Right, InStr)?
In addition, you could use a RegExp to look for the possibly empty sequence of non-| before a | and after 6 such sequences:
>> Set r = New RegExp
>> r.Pattern = "^(?:[^\|]*\|){6}([^\|]*)\|"
>> WScript.Echo r.Execute("0|1|2|3|4|5|6|7|8|9")(0).SubMatches(0)
>>
6
For production code, you'd need a check against non-confirming data.
s = "0|1|2|3|4|5|6|7|8|9"
For i = 1 To 6
intPos1 = InStr(intPos1 + 1, s, "|")
If intPos1 = 0 Then Exit For
Next
If intPos1 > 0 Then
intPos2 = InStr(intPos1 + 1, s, "|")
If intPos2 > intPos1 Then MsgBox Mid(s, intPos1 + 1, intPos2 - intPos1 - 1)
End If
Or, like #Filburt said, it could be a one-liner with Split():
MsgBox Split(s, "|")(6)
Dim s, c, n, i, p, e, r
s = "0|1|2|3|4|5|6|7|8|9" ' examined string
c = "|" ' split char
n = 6 ' occurance to start from
i = 0
p = 0
r = ""
Do
p = InStr(p + 1, s, c)
If p = 0 Then Exit Do
i = i + 1
If i = n Then
e = InStr(p + 1, s, c)
If e > 0 Then r = Mid(s, p + 1, e - p - 1)
Exit Do
End If
Loop
MsgBox r
How can I remove duplicates from an array in vbscript?
Code:
dim XObj(100),xObjXml
for s=0 to xObjXml.length-1
XObj(s)=xObjXml(s).getAttribute("xsx")
next
Please suggest a better answer for this.
Use a Dictionary to gather the unique items of the array:
>> a = Array(1, 2, 3, 1, 2, 3)
>> WScript.Echo Join(a)
>> Set d = CreateObject("Scripting.Dictionary")
>> For i = 0 To UBound(a)
>> d(a(i)) = d(a(i)) + 1
>> Next
>> WScript.Echo Join(d.Keys())
>>
1 2 3 1 2 3
1 2 3
>>
(BTW: There is no .length property for VBScript arrays)
Added:
The .Keys() method of the dictionary returns an array of the (unique) keys:
>> b = d.Keys()
>> WScript.Echo Join(b), "or:", b(2), b(1), b(0)
>>
1 2 3 or: 3 2 1
Added II: (aircode!)
Trying to get the unique attributes of the objects in an XML collection:
Dim xObjXml : Set xObjXml = ... get some collection of XML objects ...
Dim dicAttrs : Set dicAttrs = CreateObject("Scripting.Dictionary")
Dim i
For i = 0 To xObjXml.length - 1
Dim a : a = xObjXml(i).getAttribute("xsx")
dicAttrs(a) = dicAttrs(a) + 1
Next
Dim aAttrs : aAttrs = dicAttrs.Keys()
Added III (sorry!):
.Keys() is a method, so it should be called as such:
Dim aAttrs : aAttrs = dicAttrs.Keys()
Added IV:
For a working sample see here.
If you don't want a Dictionary you can use the following to compare each element in the array to itself.
Info = Array("Arup","John","Mike","John","Lisa","Arup")
x = 0
z = ubound(Info)
Do
x = x + 1
Do
z = z - 1
If x = z Then
Info(x) = Info(z)
ElseIf Info(x) = Info(z) Then
Info(x) = ""
End If
Loop Until z=0
z = ubound(Info)
Loop Until x = ubound(Info)
For each x in Info
If x <> "" Then
Unique = Unique & Chr(13) & x
End If
Next
MsgBox Unique