How to optimize cloning in new roblox update - optimization

Everything has been going smooth until the new roblox update and now my barrage effect clones make the game insanely laggy.
Any help on optimizing it would be greatly appreciated.
I know this might sound lazy but it would be great if you could optimize it for me. I have 0 idea how to optimize and this is my last hope.
local EffectModule = require(game.ServerStorage:WaitForChild("HitEffectModule"))
local event = game:GetService("ReplicatedStorage"):WaitForChild("TheWorld").Barrage -- this is the event which fires from client to server
local TweenService = game:GetService("TweenService") -- this is a very useful function for extra effects
local Debris = game:GetService("Debris")
local Damage = 1.8
local Punched = game.Workspace.Sounds.Punched
--u can get ur own one im just using a free one as an example
local function Detect(Character)
local Hitbox = script.Hitbox:Clone()
Hitbox.Parent = workspace
Hitbox.CFrame = Character.PrimaryPart.CFrame * CFrame.new(0,0,Hitbox.Size.Z/2 * -1)
Debris:AddItem(Hitbox,.3)
local Connection
Connection = Hitbox.Touched:Connect(function(hitted)
if hitted.Parent:FindFirstChild("Humanoid") and not hitted:IsDescendantOf(Character) then
local Enemy = hitted.Parent
Enemy.Humanoid:TakeDamage(Damage)
Connection:Disconnect()
Hitbox:Destroy()
local bv = Instance.new("BodyVelocity")
bv.MaxForce = Vector3.new(1e6,1e6,1e6)
bv.Velocity = Character.PrimaryPart.CFrame.LookVector * 10
Debris:AddItem(bv,.2)
bv.Parent = Enemy.PrimaryPart
EffectModule.Gore2(Enemy.UpperTorso)
Enemy.Humanoid:LoadAnimation(script.HitAnim):Play()
Punched:Play()
Enemy.Humanoid.WalkSpeed = 3
wait(1)
Enemy.Humanoid.WalkSpeed = 16
end
end)
end
local function CreateArm(Character)
local Stand = game:GetService("ServerStorage").StandModel.TheWorld
local StartXR = math.random(150,350)/100
Detect(Character)
local StartXL = math.random(150,350)/100 * -1
local StartYR = math.random(-150,250)/100
local StartYL = math.random(-150,250)/100
local LeftArmModel = Instance.new("Model")
LeftArmModel.Name = "LeftArm"
LeftArmModel.Parent = game.Workspace
Debris:AddItem(LeftArmModel,.3)
local LLA = Stand:FindFirstChild("LeftLowerArm"):Clone()
LLA.Parent = LeftArmModel
local LUA = Stand:FindFirstChild("LeftUpperArm"):Clone()
LUA.Parent = LeftArmModel
local LH = Stand:FindFirstChild("LeftHand"):Clone()
LH.Parent = LeftArmModel
local weld1 = Instance.new("WeldConstraint")
weld1.Part0 = LH
weld1.Part1 = LLA
weld1.Parent = LH
local weld2 = Instance.new("WeldConstraint")
weld2.Part0 = LUA
weld2.Part1 = LLA
weld2.Parent = LUA
for i , v in pairs(LeftArmModel:GetDescendants()) do
if v:IsA("Texture") or v:IsA("BasePart") or v:IsA("Decal") then
v.Transparency = .2
TweenService:Create(v,TweenInfo.new(.3),{Transparency = .75}):Play()
end
if v:IsA("Motor6D") then
v:Destroy()
end
end
LeftArmModel.PrimaryPart = LLA
LeftArmModel.PrimaryPart.Anchored = true
LeftArmModel.PrimaryPart.CFrame = CFrame.new(Character.PrimaryPart.CFrame * CFrame.new(StartXL,StartYL,-1.5).p,Character.PrimaryPart.CFrame * CFrame.new(StartXL * .4,StartYL * .4,-8).p) * CFrame.Angles(math.rad(90),0,0)
TweenService:Create(LeftArmModel.PrimaryPart,TweenInfo.new(.3),{CFrame = LeftArmModel.PrimaryPart.CFrame * CFrame.new(0,-5,0)}):Play()
local RightArmModel = Instance.new("Model")
RightArmModel.Name = "LeftArm"
RightArmModel.Parent = game.Workspace
Debris:AddItem(RightArmModel,.3)
local RLA = Stand:FindFirstChild("RightLowerArm"):Clone()
RLA.Parent = RightArmModel
local RUA = Stand:FindFirstChild("RightUpperArm"):Clone()
RUA.Parent = RightArmModel
local RH = Stand:FindFirstChild("RightHand"):Clone()
RH.Parent = RightArmModel
local weld1 = Instance.new("WeldConstraint")
weld1.Part0 = RH
weld1.Part1 = RLA
weld1.Parent = RH
local weld2 = Instance.new("WeldConstraint")
weld2.Part0 = RUA
weld2.Part1 = RLA
weld2.Parent = RUA
for i , v in pairs(RightArmModel:GetDescendants()) do
if v:IsA("Texture") or v:IsA("BasePart") or v:IsA("Decal") then
v.Transparency = .2
TweenService:Create(v,TweenInfo.new(.3),{Transparency = .75}):Play()
end
if v:IsA("Motor6D") then
v:Destroy()
end
end
RightArmModel.PrimaryPart = RLA
RightArmModel.PrimaryPart.Anchored = true
RightArmModel.PrimaryPart.CFrame = CFrame.new(Character.PrimaryPart.CFrame * CFrame.new(StartXR,StartYR,-1.5).p,Character.PrimaryPart.CFrame * CFrame.new(StartXR * .4,StartYR * .4,-8).p) * CFrame.Angles(math.rad(90),0,0)
TweenService:Create(RightArmModel.PrimaryPart,TweenInfo.new(.3),{CFrame = RightArmModel.PrimaryPart.CFrame * CFrame.new(0,-5,0)}):Play()
end
event.OnServerEvent:Connect(function(Player,hold)
local Character = Player.Character
local Stand = Character:FindFirstChild(Character.Name)
if Stand then
if not Character:FindFirstChild("Barraging") then
if hold == true and Character.UsingMove.Value == false then
local barraging = Instance.new("BoolValue")
barraging.Name = "Barraging"
barraging.Parent = Character
Character.UsingMove.Value = true
Character.PrimaryPart.StandPosition.Position = Vector3.new(0,-1,-2)
local Anim = Stand.AnimationController:LoadAnimation(script.Anim)
Anim:Play()
local Sound = script.BarrageSound:Clone()
Sound.Parent = Character.PrimaryPart
Sound:Play()
local Starttime = tick()
repeat
wait(.30)
CreateArm(Character)
until tick() - Starttime >= 5 or not Character:FindFirstChild("Barraging")
Character.PrimaryPart.StandPosition.Position = Vector3.new(-2,0.7,3)
Anim:Stop()
Sound:Destroy()
Character.UsingMove.Value = false
end
else
Character:FindFirstChild("Barraging"):Destroy()
end
end
end)

Instead of cloning it from a storage, at the start just clone a bunch of them and keep them very high up in sky so that it wont be rendered, and as you need them position them accordingly while switching them.

Related

How to speed up simple linear algebra optimization probelm in Julia?

I implemented the LSDD changepoint detection method decribed in [1] in Julia, to see if I could make it faster than the existing python implementation [2], which is based on a grid search that looks for the optimal parameters.
I obtain the desired results but despite my best efforts, my grid search version of it takes about the same time to compute as the python one, which is still way too long for real applications.
I also tried using the Optimize package which only makes things worse (2 or 3 times slower).
Here is the grid search that I implemented :
using Random
using LinearAlgebra
function squared_distance(X::Array{Float64,1},C::Array{Float64,1})
sqd = zeros(length(X),length(C))
for i in 1:length(X)
for j in 1:length(C)
sqd[i,j] = X[i]^2 + C[j]^2 - 2*X[i]*C[j]
end
end
return sqd
end
function lsdd(x::Array{Float64,1},y::Array{Float64,1}; folds = 5, sigma_list = nothing , lambda_list = nothing)
lx,ly = length(x), length(y)
b = min(lx+ly,300)
C = shuffle(vcat(x,y))[1:b]
CC_dist2 = squared_distance(C,C)
xC_dist2, yC_dist2 = squared_distance(x,C), squared_distance(y,C)
Tx,Ty = length(x) - div(lx,folds), length(y) - div(ly,folds)
#Define the training and testing data sets
cv_split1, cv_split2 = floor.(collect(1:lx)*folds/lx), floor.(collect(1:ly)*folds/ly)
cv_index1, cv_index2 = shuffle(cv_split1), shuffle(cv_split2)
tr_idx1,tr_idx2 = [findall(x->x!=i,cv_index1) for i in 1:folds], [findall(x->x!=i,cv_index2) for i in 1:folds]
te_idx1,te_idx2 = [findall(x->x==i,cv_index1) for i in 1:folds], [findall(x->x==i,cv_index2) for i in 1:folds]
xTr_dist, yTr_dist = [xC_dist2[i,:] for i in tr_idx1], [yC_dist2[i,:] for i in tr_idx2]
xTe_dist, yTe_dist = [xC_dist2[i,:] for i in te_idx1], [yC_dist2[i,:] for i in te_idx2]
if sigma_list == nothing
sigma_list = [0.25, 0.5, 0.75, 1, 1.2, 1.5, 2, 2.5, 2.2, 3, 5]
end
if lambda_list == nothing
lambda_list = [1.00000000e-03, 3.16227766e-03, 1.00000000e-02, 3.16227766e-02,
1.00000000e-01, 3.16227766e-01, 1.00000000e+00, 3.16227766e+00,
1.00000000e+01]
end
#memory prealocation
score_cv = zeros(length(sigma_list),length(lambda_list))
H = zeros(b,b)
hx_tr, hy_tr = [zeros(b,1) for i in 1:folds], [zeros(b,1) for i in 1:folds]
hx_te, hy_te = [zeros(1,b) for i in 1:folds], [zeros(1,b) for i in 1:folds]
#h_tr,h_te = zeros(b,1), zeros(1,b)
theta = zeros(b)
for (sigma_idx,sigma) in enumerate(sigma_list)
#the expression of H is different for higher dimension
#H = sqrt((sigma^2)*pi)*exp.(-CC_dist2/(4*sigma^2))
set_H(H,CC_dist2,sigma,b)
#check if the sum is performed along the right dimension
set_htr(hx_tr,xTr_dist,sigma,Tx), set_htr(hy_tr,yTr_dist,sigma,Ty)
set_hte(hx_te,xTe_dist,sigma,lx-Tx), set_hte(hy_te,yTe_dist,sigma,ly-Ty)
for i in 1:folds
h_tr = hx_tr[i] - hy_tr[i]
h_te = hx_te[i] - hy_te[i]
#set_h(h_tr,hx_tr[i],hy_tr[i],b)
#set_h(h_te,hx_te[i],hy_te[i],b)
for (lambda_idx,lambda) in enumerate(lambda_list)
set_theta(theta,H,lambda,h_tr,b)
score_cv[sigma_idx,lambda_idx] += dot(theta,H*theta) - 2*dot(theta,h_te)
end
end
end
#retrieve the value of the optimal parameters
sigma_chosen = sigma_list[findmin(score_cv)[2][2]]
lambda_chosen = lambda_list[findmin(score_cv)[2][2]]
#calculating the new "optimal" solution
H = sqrt((sigma_chosen^2)*pi)*exp.(-CC_dist2/(4*sigma_chosen^2))
H_lambda = H + lambda_chosen*Matrix{Float64}(I, b, b)
h = (1/lx)*sum(exp.(-xC_dist2/(2*sigma_chosen^2)),dims = 1) - (1/ly)*sum(exp.(-yC_dist2/(2*sigma_chosen^2)),dims = 1)
theta_final = H_lambda\transpose(h)
f = transpose(theta_final).*sum(exp.(-vcat(xC_dist2,yC_dist2)/(2*sigma_chosen^2)),dims = 1)
L2 = 2*dot(theta_final,h) - dot(theta_final,H*theta_final)
return L2
end
function set_H(H::Array{Float64,2},dist::Array{Float64,2},sigma::Float64,b::Int16)
for i in 1:b
for j in 1:b
H[i,j] = sqrt((sigma^2)*pi)*exp(-dist[i,j]/(4*sigma^2))
end
end
end
function set_theta(theta::Array{Float64,1},H::Array{Float64,2},lambda::Float64,h::Array{Float64,2},b::Int64)
Hl = (H + lambda*Matrix{Float64}(I, b, b))
LAPACK.posv!('L', Hl, h)
theta = h
end
function set_htr(h::Array{Float64,1},dists::Array{Float64,2},sigma::Float64,T::Int16)
for (CVidx,dist) in enumerate(dists)
for (idx,value) in enumerate((1/T)*sum(exp.(-dist/(2*sigma^2)),dims = 1))
h[CVidx][idx] = value
end
end
end
function set_hte(h::Array{Float64,1},dists::Array{Float64,2},sigma::Array{Float64,1},T::Int16)
for (CVidx,dist) in enumerate(dists)
for (idx,value) in enumerate((1/T)*sum(exp.(-dist/(2*sigma^2)),dims = 1))
h[CVidx][idx] = value
end
end
end
function set_h(h,h1,h2,b)
for i in 1:b
h[i] = h1[i] - h2[i]
end
end
The set_H, set_h and set_theta functions are there because I read somewhere that modifying prealocated memory in place with a function was faster, but it did not make a great difference.
To test it, I use two random distribution as input data :
x,y = rand(500),1.5*rand(500)
lsdd(x,y) #returns a value around 0.3
Now here is the version of the code where I try to use Optimizer :
function Theta(sigma::Float64,lambda::Float64,x::Array{Float64,1},y::Array{Float64,1},folds::Int8)
lx,ly = length(x), length(y)
b = min(lx+ly,300)
C = shuffle(vcat(x,y))[1:b]
CC_dist2 = squared_distance(C,C)
xC_dist2, yC_dist2 = squared_distance(x,C), squared_distance(y,C)
#the subsets are not be mutually exclusive !
Tx,Ty = length(x) - div(lx,folds), length(y) - div(ly,folds)
shuffled_x, shuffled_y = [shuffle(1:lx) for i in 1:folds], [shuffle(1:ly) for i in 1:folds]
cv_index1, cv_index2 = floor.(collect(1:lx)*folds/lx)[shuffle(1:lx)], floor.(collect(1:ly)*folds/ly)[shuffle(1:ly)]
tr_idx1,tr_idx2 = [i[1:Tx] for i in shuffled_x], [i[1:Ty] for i in shuffled_y]
te_idx1,te_idx2 = [i[Tx:end] for i in shuffled_x], [i[Ty:end] for i in shuffled_y]
xTr_dist, yTr_dist = [xC_dist2[i,:] for i in tr_idx1], [yC_dist2[i,:] for i in tr_idx2]
xTe_dist, yTe_dist = [xC_dist2[i,:] for i in te_idx1], [yC_dist2[i,:] for i in te_idx2]
score_cv = 0
Id = Matrix{Float64}(I, b, b)
H = sqrt((sigma^2)*pi)*exp.(-CC_dist2/(4*sigma^2))
hx_tr, hy_tr = [transpose((1/Tx)*sum(exp.(-dist/(2*sigma^2)),dims = 1)) for dist in xTr_dist], [transpose((1/Ty)*sum(exp.(-dist/(2*sigma^2)),dims = 1)) for dist in yTr_dist]
hx_te, hy_te = [(lx-Tx)*sum(exp.(-dist/(2*sigma^2)),dims = 1) for dist in xTe_dist], [(ly-Ty)*sum(exp.(-dist/(2*sigma^2)),dims = 1) for dist in yTe_dist]
for i in 1:folds
h_tr, h_te = hx_tr[i] - hy_tr[i], hx_te[i] - hy_te[i]
#theta = (H + lambda * Id)\h_tr
theta = copy(h_tr)
Hl = (H + lambda*Matrix{Float64}(I, b, b))
LAPACK.posv!('L', Hl, theta)
score_cv += dot(theta,H*theta) - 2*dot(theta,h_te)
end
return score_cv,(CC_dist2,xC_dist2,yC_dist2)
end
function cost(params::Array{Float64,1},x::Array{Float64,1},y::Array{Float64,1},folds::Int8)
s,l = params[1],params[2]
return Theta(s,l,x,y,folds)[1]
end
"""
Performs the optinization
"""
function lsdd3(x::Array{Float64,1},y::Array{Float64,1}; folds = 4)
start = [1,0.1]
b = min(length(x)+length(y),300)
lx,ly = length(x),length(y)
#result = optimize(params -> cost(params,x,y,folds),fill(0.0,2),fill(50.0,2),start, Fminbox(LBFGS(linesearch=LineSearches.BackTracking())); autodiff = :forward)
result = optimize(params -> cost(params,x,y,folds),start, BFGS(),Optim.Options(f_calls_limit = 5, iterations = 5))
#bboptimize(rosenbrock2d; SearchRange = [(-5.0, 5.0), (-2.0, 2.0)])
#result = optimize(cost,[0,0],[Inf,Inf],start, Fminbox(AcceleratedGradientDescent()))
sigma_chosen,lambda_chosen = Optim.minimizer(result)
CC_dist2, xC_dist2, yC_dist2 = Theta(sigma_chosen,lambda_chosen,x,y,folds)[2]
H = sqrt((sigma_chosen^2)*pi)*exp.(-CC_dist2/(4*sigma_chosen^2))
h = (1/lx)*sum(exp.(-xC_dist2/(2*sigma_chosen^2)),dims = 1) - (1/ly)*sum(exp.(-yC_dist2/(2*sigma_chosen^2)),dims = 1)
theta_final = (H + lambda_chosen*Matrix{Float64}(I, b, b))\transpose(h)
f = transpose(theta_final).*sum(exp.(-vcat(xC_dist2,yC_dist2)/(2*sigma_chosen^2)),dims = 1)
L2 = 2*dot(theta_final,h) - dot(theta_final,H*theta_final)
return L2
end
No matter, which kind of option I use in the optimizer, I always end up with something too slow. Maybe the grid search is the best option, but I don't know how to make it faster... Does anyone have an idea how I could proceed further ?
[1] : http://www.mcduplessis.com/wp-content/uploads/2016/05/Journal-IEICE-2014-CLSDD-1.pdf
[2] : http://www.ms.k.u-tokyo.ac.jp/software.html

VB replacing an object in a list

I have 2 lists approvedSuppliers and originalSupplierData
When approved Suppliers gets populated we clone the entry into the originalSupplierData . If they have modified a record but don't save we ask the user if they want to revert the changes . If they want to revert I am trying to replace the entry in approved suppliers with a clone of the original data. My current code for the revert is
Public Sub RevertChanges(SupplierID As Integer)
Dim orignalSupplier As Approved_Supplier = originalSupplierlist.Where(Function(x) x.ID = SupplierID).Single()
Dim modifiedSupplier As Approved_Supplier = ApprovedSuppliers.Where(Function(x) x.ID = SupplierID).Single()
modifiedSupplier = orignalSupplier.Clone
End Sub
The modifiedSupplier gets updated with the original values however the actual item in the list is not updated with the values.
If I modify one of the properties the list gets update. I am not sure what i am doing wrong can anyone point me in the right direction please?
Edit
The code for populating the list from the database is
supplierTableAdapter.Fill(supplierTable)
_approvedSuppliers = New List(Of Approved_Supplier)
originalSupplierlist = New List(Of Approved_Supplier)()
For Each row As ApprovedSuppliersDataset.ApprovedSupplierRow In supplierTable
supplier = New Approved_Supplier()
supplier.supplierID = row.PLSupplierAccountID
supplier.AccountNumber = row.SupplierAccountNumber
supplier.SupplierName = row.SupplierAccountName
supplier.SupplierAddress = CompileAddress(row)
supplier.Phone = CompilePhoneNumber(row)
If row.IsIDNull = False Then
supplier.ID = row.ID
If row.IsAdded_ByNull = False Then
supplier.AddedBy = row.Added_By
End If
If row.IsApprovedNull = False Then
supplier.Approved = row.Approved
End If
If row.IsAuditorNull = False Then
supplier.Auditor = row.Auditor
End If
If row.IsAudit_CommentsNull = False Then
supplier.AuditComments = row.Audit_Comments
End If
If row.IsAudit_DateNull = False Then
supplier.AuditDate = row.Audit_Date
End If
If row.IsDate_AddedNull = False Then
supplier.DateAdded = row.Date_Added
End If
If row.IsNotesNull = False Then
supplier.Notes = row.Notes
End If
If row.IsQuestionnaire_Return_DateNull = False Then
supplier.QuestionnaireReturnDate = row.Questionnaire_Return_Date
End If
If row.IsQuestionnaire_Sent_DateNull = False Then
supplier.QuestionnaireSentDate = row.Questionnaire_Sent_Date
End If
If row.IsQuestionnaire_StatusNull = False Then
supplier.QuestionnaireStatus = row.Questionnaire_Status
End If
If row.IsReplinNull = False Then
supplier.Replin = row.Replin
End If
If row.IsReview_CommentsNull = False Then
supplier.ReviewComment = row.Review_Comments
End If
If row.IsReview_DateNull = False Then
supplier.ReviewDate = row.Review_Date
End If
If row.IsReviewerNull = False Then
supplier.Reviewers = row.Reviewer
End If
If row.IsStakeholder_ContactNull = False Then
supplier.StakeholderContact = row.Stakeholder_Contact
End If
If row.IsStandardsNull = False Then
supplier.Standards = row.Standards
End If
If row.IsStandard_ExpiryNull = False Then
supplier.StandardExpiry = row.Standard_Expiry
End If
If row.IsStatusNull = False Then
supplier.Status = row.Status
End If
If row.IsSupplier_Expiry_DateNull = False Then
supplier.SupplierExpiryDate = row.Supplier_Expiry_Date
End If
If row.IsSupplier_ScopeNull = False Then
supplier.SupplierScope = row.Supplier_Scope
End If
If row.Is_T_CsNull = False Then
supplier.TC = row._T_Cs
End If
End If
supplier.ClearISDirty()
_approvedSuppliers.Add(supplier)
originalSupplierlist.Add(supplier.Clone)
Next
and for the clone we have
Public Function Clone() As Object Implements ICloneable.Clone
Dim cloned As New Approved_Supplier()
cloned.ID = Me.ID
cloned.DateAdded = Me.DateAdded
cloned.Status = Me.Status
cloned.AddedBy = Me.AddedBy
cloned.Approved = Me.Approved
cloned.AuditDate = Me.AuditDate
cloned.Auditor = Me.Auditor
cloned.AuditComments = Me.AuditComments
cloned.QuestionnaireStatus = Me.QuestionnaireStatus
cloned.QuestionnaireSentDate = Me.QuestionnaireSentDate
cloned.QuestionnaireReturnDate = Me.QuestionnaireReturnDate
cloned.ReviewDate = Me.ReviewDate
cloned.Reviewers = Me.Reviewers
cloned.ReviewComment = Me.ReviewComment
cloned.Standards = Me.Standards
cloned.StandardExpiry = Me.StandardExpiry
cloned.SupplierScope = Me.SupplierScope
cloned.Replin = Me.Replin
cloned.TC = Me.TC
cloned.Notes = Me.Notes
cloned.StakeholderContact = Me.StakeholderContact
cloned.SupplierExpiryDate = Me.SupplierExpiryDate
cloned.supplierID = Me.supplierID
cloned.AccountNumber = Me.AccountNumber
cloned.SupplierName = Me.SupplierName
cloned.SupplierAddress = Me.SupplierAddress
cloned.Phone = Me.Phone
cloned.Email = Me.Email
cloned.ClearISDirty()
Return cloned
End Function
You are not replacing in the list by affecting modifiedSupplier.
Try by getting the index of the modifiedSupplier and then replacing the item at the found index by your clone.
Public Sub RevertChanges(SupplierID As Integer)
Dim orignalSupplier As Approved_Supplier = originalSupplierlist.Where(Function(x) x.ID = SupplierID).Single()
Dim modifiedIndex As Integer = ApprovedSuppliers.FindIndex(Function(x) x.ID = SupplierID)
ApprovedSuppliers(modifiedIndex) = orignalSupplier.Clone()
End Sub

vb6 to vb.net for OracleInProcServer.OraDynaset

I am converting a project which is coded in old vb6 way. I am replacing the instances of OracleInProcServer.OraDynaset to Datatable for getting the data from database. But a form is generated in a dynamic way has the below code. i don't know how be there a alternate code for there in vb.net. Is there any way I can replace the below code without using dsAnswer As OracleInProcServer.OraDynaset. I don't know what is ! here also and how it is working.
Dim dsAnswer As OracleInProcServer.OraDynaset
Select Case dsAnswer!Shape.Value
Case 0 To 5
iShapes = iShapes + 1
'Load(f!shpCtrl(iShapes))
frmDynaForm.shpCtrl.Load(iShapes)
frmDynaForm.shpCtrl(iShapes).FillColor = System.Drawing.Color.FromArgb(DecodeColorDesc(Format$(dsAnswer!Color.Value)))
'frmDynaForm.shpCtrl(iShapes).Shape = dsAnswer!Shape.Value
frmDynaForm.shpCtrl(iShapes).Top = dsAnswer!Top.Value
frmDynaForm.shpCtrl(iShapes).Left = dsAnswer!Left.Value
frmDynaForm.shpCtrl(iShapes).Height = dsAnswer!Height.Value
frmDynaForm.shpCtrl(iShapes).Width = dsAnswer!Width.Value
frmDynaForm.shpCtrl(iShapes).BorderWidth = dsAnswer!BorderWidth.Value
frmDynaForm.shpCtrl(iShapes).Visible = True
Case -1
iLines = iLines + 1
'Load(f!lineCtrl(iLines))
frmDynaForm.lineCtrl.Load(iShapes)
frmDynaForm.lineCtrl(iLines).BorderColor = System.Drawing.Color.FromArgb(DecodeColorDesc(Format$(dsAnswer!Color.Value)))
frmDynaForm.lineCtrl(iLines).Y1 = dsAnswer!Top.Value
frmDynaForm.lineCtrl(iLines).X1 = dsAnswer!Left.Value
frmDynaForm.lineCtrl(iLines).Y2 = dsAnswer!Height.Value
frmDynaForm.lineCtrl(iLines).X2 = dsAnswer!Width.Value
frmDynaForm.lineCtrl(iLines).BorderWidth = dsAnswer!BorderWidth.Value
frmDynaForm.lineCtrl(iLines).Visible = True
End Select

Run-time error 91: Object variable or With block variable not set

I'm using Access 2010 VBA that is returning a recordset from an IBM iSeries. I have the following loop to append the recordset to a local table:
'Loop through recordset and place values
Do While rsti401.EOF = False
Set rst401 = CurrentDb.OpenRecordset("tblLocal_SL401WK", dbOpenDynaset, dbSeeChanges)
With rst401
.AddNew
.Fields("PC") = rsti401.Fields("PC")
.Fields("TIME") = rsti401.Fields("TIME")
.Fields("CONO") = rsti401.Fields("CONO")
.Fields("STYCOL") = rsti401.Fields("STYCOL")
.Fields("WHSE") = rsti401.Fields("WHSE")
.Fields("CUNO") = rsti401.Fields("CUNO")
.Fields("SIZE01") = rsti401.Fields("SIZE01")
.Fields("SIZE02") = rsti401.Fields("SIZE02")
.Fields("SIZE03") = rsti401.Fields("SIZE03")
.Fields("SIZE04") = rsti401.Fields("SIZE04")
.Fields("SIZE05") = rsti401.Fields("SIZE05")
.Fields("SIZE06") = rsti401.Fields("SIZE06")
.Fields("SIZE07") = rsti401.Fields("SIZE07")
.Fields("SIZE08") = rsti401.Fields("SIZE08")
.Fields("SIZE09") = rsti401.Fields("SIZE09")
.Fields("SIZE10") = rsti401.Fields("SIZE10")
.Fields("SIZE11") = rsti401.Fields("SIZE11")
.Fields("SIZE12") = rsti401.Fields("SIZE12")
.Fields("SIZE13") = rsti401.Fields("SIZE13")
.Fields("SIZE14") = rsti401.Fields("SIZE14")
.Fields("SIZE15") = rsti401.Fields("SIZE15")
.Fields("BQTY01") = rsti401.Fields("BQTY01")
.Fields("BQTY02") = rsti401.Fields("BQTY02")
.Fields("BQTY03") = rsti401.Fields("BQTY03")
.Fields("BQTY04") = rsti401.Fields("BQTY04")
.Fields("BQTY05") = rsti401.Fields("BQTY05")
.Fields("BQTY06") = rsti401.Fields("BQTY06")
.Fields("BQTY07") = rsti401.Fields("BQTY07")
.Fields("BQTY08") = rsti401.Fields("BQTY08")
.Fields("BQTY09") = rsti401.Fields("BQTY09")
.Fields("BQTY10") = rsti401.Fields("BQTY10")
.Fields("BQTY11") = rsti401.Fields("BQTY11")
.Fields("BQTY12") = rsti401.Fields("BQTY12")
.Fields("BQTY13") = rsti401.Fields("BQTY13")
.Fields("BQTY14") = rsti401.Fields("BQTY14")
.Fields("BQTY15") = rsti401.Fields("BQTY15")
.Update
End With
rsti401.MoveNext
Loop
'close connections
rsti401.Close
rst401.Close
IBM.Close
Set IBM = Nothing
Set rst401 = Nothing
Set rsti401 = Nothing
Set CMD = Nothing
However, each time I run it I is stopping at the following line:
rst401.Close
With error 'Run-time error 91'. I can't work it out. I've set rst401 at the beginning, so why am I still getting the error.
Any pointers would be a great help.
Thanks,
Michael
The problem you have is because the rst401 is set inside the Do While Loop, and you are trying to close an object that has lost its scope outside the Loop. Suggest you make the following changes.
'Loop through recordset and place values
Set rst401 = CurrentDb.OpenRecordset("tblLocal_SL401WK", dbOpenDynaset, dbSeeChanges)
Do While rsti401.EOF = False
With rst401
.AddNew
.Fields("PC") = rsti401.Fields("PC")
.Fields("TIME") = rsti401.Fields("TIME")
.Fields("CONO") = rsti401.Fields("CONO")
.Fields("STYCOL") = rsti401.Fields("STYCOL")
.Fields("WHSE") = rsti401.Fields("WHSE")
.Fields("CUNO") = rsti401.Fields("CUNO")
.Fields("SIZE01") = rsti401.Fields("SIZE01")
.Fields("SIZE02") = rsti401.Fields("SIZE02")
.Fields("SIZE03") = rsti401.Fields("SIZE03")
.Fields("SIZE04") = rsti401.Fields("SIZE04")
.Fields("SIZE05") = rsti401.Fields("SIZE05")
.Fields("SIZE06") = rsti401.Fields("SIZE06")
.Fields("SIZE07") = rsti401.Fields("SIZE07")
.Fields("SIZE08") = rsti401.Fields("SIZE08")
.Fields("SIZE09") = rsti401.Fields("SIZE09")
.Fields("SIZE10") = rsti401.Fields("SIZE10")
.Fields("SIZE11") = rsti401.Fields("SIZE11")
.Fields("SIZE12") = rsti401.Fields("SIZE12")
.Fields("SIZE13") = rsti401.Fields("SIZE13")
.Fields("SIZE14") = rsti401.Fields("SIZE14")
.Fields("SIZE15") = rsti401.Fields("SIZE15")
.Fields("BQTY01") = rsti401.Fields("BQTY01")
.Fields("BQTY02") = rsti401.Fields("BQTY02")
.Fields("BQTY03") = rsti401.Fields("BQTY03")
.Fields("BQTY04") = rsti401.Fields("BQTY04")
.Fields("BQTY05") = rsti401.Fields("BQTY05")
.Fields("BQTY06") = rsti401.Fields("BQTY06")
.Fields("BQTY07") = rsti401.Fields("BQTY07")
.Fields("BQTY08") = rsti401.Fields("BQTY08")
.Fields("BQTY09") = rsti401.Fields("BQTY09")
.Fields("BQTY10") = rsti401.Fields("BQTY10")
.Fields("BQTY11") = rsti401.Fields("BQTY11")
.Fields("BQTY12") = rsti401.Fields("BQTY12")
.Fields("BQTY13") = rsti401.Fields("BQTY13")
.Fields("BQTY14") = rsti401.Fields("BQTY14")
.Fields("BQTY15") = rsti401.Fields("BQTY15")
.Update
End With
rsti401.MoveNext
Loop
'close connections
rsti401.Close
rst401.Close
IBM.Close
Set IBM = Nothing
Set rst401 = Nothing
Set rsti401 = Nothing
Set CMD = Nothing

Error in assigning object of nullable type in vb.net

I am new to VB.net and facing a strange situation. I have a structure that contains another structure. The inner structure is nullable. Now wht I do is something like the following. I create a new instance of the inner structure, set the member variables and assign the whole structure to the inner structure of the parent. But it is giving an error. The assignment is not successful. If I try to peek into the structure in the watch window, it says "property evaluation failed" for the HasValue and Value properties.
Dim testData As List(Of TestData) = Nothing
Dim testData_List1 As New TestData
With testData_List1.commonTestParam
.AccuchekActiveEnergy = 2.56
.AccuchekActiveEnergyUnit = ActiveEnergyUnit.KiloWattHour
.AccuchekApparentEnergy = 34.56
.AccuchekApparentEnergyUnit = ApparentEnergyUnit.VoltAmpereHour
.AccuchekFrequency = 1
.AccuchekRange = "20474 ewr 34324"
.AccuchekType = AccuchekType.AccuchekOne
.ActiveLoadRPhase = 145
.AvgActiveLoad = 2.56
.AvgActiveLoadUnit = ActiveLoadUnit.Watt
.AvgPowerFactor = 0
.AvgPowerFactorType = PowerFactorType.PFLag
.ConditionalFlag1 = 0
.ConsumerNo = "343122050242"
.CurrentRPhase = 1
.GeneralFlag1 = 0
.InstantaneousPFRPhase = 2
.ManufacturingYear = 2009
.MeterActiveEnergy = 258.89
.MeterActiveEnergyUnit = ActiveEnergyUnit.KiloWattHour
.MeterActiveError = 20
.MeterApparentError = 14
.MeterConstant = 3200
.MeterConstantUnit = MeterConstantUnit.RevsPerkVAh
.MeterMake = "DS"
.MeterSNo = "6563402"
.MeterTypeAndClass = MeterTypeAndClass.MTCElectorMechWith20
.MTFID = "123456789"
.NoofTestRevolutions = 100
.PulseCriteria = 0
.RatedBasic = 25
.RatedMax = 30
.RatedVoltage = 15
.ReactiveCurrentRPhase = 145
.RemarkID = 0
.TestDateAndTime = "100320101545"
.TestDuration = 2145
.TesterCode = 0
.TestID = "147852"
.TestMode = TestMode.TMOpticalScanner
.TestNumber = 0
.VoltageRPhase = 145
End With
Dim accuchek3TestParameters1 As New Accuchek3PhaseTestParameters
With accuchek3TestParameters1
.AccuchekReactiveLagEnergy = 2.46
.AccuchekReactiveLagEnergyUnit = ReactiveEnergyUnit.KiloVoltAmpereReactiveHour
.AccuchekReactiveLeadEnergy = 2.56
.AccuchekReactiveLeadEnergyUnit = ReactiveEnergyUnit.KiloVoltAmpereReactiveHour
.ActiveLoadBPhase = 14
.ActiveLoadYPhase = 15
.AvgApparentLoad = 10
.AvgApparentLoadUnit = ApparentLoadUnit.KiloVoltAmpere
.AvgReactiveLagLoad = 14
.AvgReactiveLagLoadUnit = ReactiveLoadUnit.KiloVoltAmpereReactive
.AvgReactiveLeadLoad = 15
.AvgReactiveLeadLoadUnit = ReactiveLoadUnit.KiloVoltAmpereReactive
.ConditionalFlag2 = 0
.ConditionalFlag3 = 0
.CTRatio = 1.23
.CurrentBPhase = 10
.CurrentYPhase = 11
.InstantaneousPFBPhase = 0
.InstantaneousPFYPhase = 1
.MeterApparentEnergy = 1.01
.MeterApparentUnit = ApparentEnergyUnit.KiloVoltAmpereHour
.MeterReactiveLagEnergy = 1.25
.MeterReactiveLagError = 1.25
.MeterReactiveLagUnit = ReactiveEnergyUnit.KiloVoltAmpereReactiveHour
.MeterReactiveLeadEnergy = 1.45
.MeterReactiveLeadError = 1.56
.MeterReactiveLeadUnit = ReactiveEnergyUnit.KiloVoltAmpereReactiveHour
.PercentageLoad = 1
.PTRatio = 1
.ReactiveCurrentBPhase = 10
.ReactiveCurrentYPhase = 11
.VoltageBPhase = 10
.VoltageYPhase = 10
End With
testData_List1.accuchek3TestParameters = accuchek3TestParameters1
testData.Add(testData_List1)
Can somebody please guide me?
Your first line is:
Dim testData As List(Of TestData) = Nothing
Then at the bottom you do
testData.Add(testData_List1)
I can't see anywhere in between where you do something like:
testData = New List(Of TestData)()
Though it's slightly hard to read since you've got both a variables and types with TestData as their name (or part of their name) so I might just be missing that.