I am trying to convert string to double in UFT but It shows the output without decimal point. below is the code for reference.
vStr = "1000000.589765"
msgbox Typename(vStr)
strV1=CDBL(formatNumber(vStr,4))
msgbox Typename(strV1)
print strV1
Output: 1000000589765
Note that without formatNumber, its not working.
Yet another implementation using DotNetFactory. Just an another thought. I am not denying to use CDbl. But worth to give a shot.
'Test Code
Dim strConvertedCode
strConvertedCode = ConvertDataType("1000000.589765","Double")
If strConvertedCode <> null Then
Msgbox strConvertedCode
End If
Public Function ConvertDataType(ByVal SourceData,ByVal ConversionDataType)
'Initialization of variables
Dim objDotNetFactory
Dim strConvertedData : strConvertedData = null
Dim strSystemNamespace
'Determine the destination data type
Select Case UCase(ConversionDataType)
Case "DOUBLE"
strSystemNamespace = "System.Double"
'Implement further for your data types
'Reference https://msdn.microsoft.com/en-us/library/ms228360(v=vs.90).aspx
Case Default
Set objDotNetFactory = DotNetFactory.CreateInstance("System.Int32")
End Select
Set objDotNetFactory = DotNetFactory.CreateInstance(strSystemNamespace)
'Check the dot net factory instance is successful
If Not IsObject(objDotNetFactory) Then
Reporter.ReportEvent micWarning,"Data type convertor","Conversion from String to " & ConversionDataType & " failed, Since DotNetFactory instance was not created."
ConvertDataType = strConvertedData
Exit Function
End If
strConvertedData = objDotNetFactory.Parse(SourceData)
ConvertDataType = strConvertedData
End Function
I am new to vb6 so might be obvious for some of you.I have a collection problem, trying to put items in a collection to then evaluate if the item exists and setting a button to be enabled or not.
The Code:
For Each vBookmark In lstAssign.SelBookmarks
'---------------------------------------
'filtering with agency code and crew code.
sAssignmentValue = lstAssign.columns("AgencyCode").Value & lstAssign.columns("CrewCode").Value
'Show/hide value depending on crew existance.
If Not ExistsStartLocation(colParameters, sValue) Then
bEnableMyButton = True
colParameters.Add (sValue)
Else
bEnableMyButton = False
End If
'----------------------------------------
Next
sAssignmentValue = ""
tbrMain.TbrButtonEnabled "XXX", bEnableMyButton
tbrMain.TbrButtonEnabled "YYY", bEnable
Set colStartLocationParameters = Nothing
Exit Sub
Private Function ExistsStartLocation(col As collection, index As Variant) As Boolean
On Error GoTo ErrHandler
Dim v As Variant
v = col(index)
ExistsStartLocation = True
Exit Function
ErrHandler:
ExistsStartLocation = False
End Function
The problem is at this moment is that I only have colParameters(index) accessible, so I can't access my collection with a value "123-ABC" directly. I do not want to add an integer index, I want to keep simply accessing by item value, but my exists method will always return false. therefore always disabling my button.
How does this works?
At first glance, you should have to do something like this:
Private Function ExistsStartLocation(col As collection, val As String) As Boolean
Dim blnFoundItem As Boolean = False
For index As Integer = 1 To col.Count
If col(index) = val Then
blnFoundItem = True
End If
Next
ExistsStartLocation = blnFoundItem
End Function
Looping the collection works but is not efficient. If you assign the optional Key value in the Add method you can also use that as the Index to the Item method. In your example it appears you are assigning a string to the collection so the Add method would look something like ...
colParameters.Add sValue, sValue
Be aware though that if you are adding duplicate values this won't work. The keys need to be unique.
With the the collection item's key populated you can use a function that leverages the err object. If you try to get a collection item by the key and it exists no error is thrown. If it does not exists err.number 5 is thrown. The new function would be something like this.
Public Function ItemExists(ByVal vCollection As Collection, ByVal vKey As String) As Boolean
Dim varItem As Variant
On Error Resume Next
varItem = vCollection.Item(vKey)
ItemExists = (Err.Number = 0)
End Function
I have both AutoCAD and AutoCAD Architecture installed on my system. AutoCAD Architecture has a tab called Vision Tools with a nifty command called Display By Layer to set the display order of objects in accordance with the layers of the drawing. Is there anyway to add this tab or use this command in AutoCAD?
Not sure if you're looking for a built-in feature or APIs for it.
For a built in feature, check the DRAWORDER command. For an API/programming approach, check the respective DrawOrderTable method. See below:
Update: please also check this 3rd party tool: DoByLayer.
[CommandMethod("SendToBottom")]
public void commandDrawOrderChange()
{
Document activeDoc
= Application.DocumentManager.MdiActiveDocument;
Database db = activeDoc.Database;
Editor ed = activeDoc.Editor;
PromptEntityOptions peo
= new PromptEntityOptions("Select an entity : ");
PromptEntityResult per = ed.GetEntity(peo);
if (per.Status != PromptStatus.OK)
{
return;
}
ObjectId oid = per.ObjectId;
SortedList<long, ObjectId> drawOrder
= new SortedList<long, ObjectId>();
using (Transaction tr = db.TransactionManager.StartTransaction())
{
BlockTable bt = tr.GetObject(
db.BlockTableId,
OpenMode.ForRead
) as BlockTable;
BlockTableRecord btrModelSpace =
tr.GetObject(
bt[BlockTableRecord.ModelSpace],
OpenMode.ForRead
) as BlockTableRecord;
DrawOrderTable dot =
tr.GetObject(
btrModelSpace.DrawOrderTableId,
OpenMode.ForWrite
) as DrawOrderTable;
ObjectIdCollection objToMove = new ObjectIdCollection();
objToMove.Add(oid);
dot.MoveToBottom(objToMove);
tr.Commit();
}
ed.WriteMessage("Done");
}
With some help from VBA it might look by this. Note i did not add fancy listbox code. I just show the worker and how to list layers. The trivial Code to add things to a listbox on a form and how to sort / rearrange listbox items can be found on any excel / VBA forum on the web . Or you just uses a predefined string like in the example. To get VBA to work download and install the acc. VBA Enabler from autocad. It is free.
'select all items on a layer by a filter
Sub selectALayer(sset As AcadSelectionSet, layername As String)
Dim filterType As Variant
Dim filterData As Variant
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim grpCode(0) As Integer
grpCode(0) = 8
filterType = grpCode
Dim grpValue(0) As Variant
grpValue(0) = layername
filterData = grpValue
sset.Select acSelectionSetAll, p1, p2, filterType, filterData
Debug.Print "layer", layername, "Entities: " & str(sset.COUNT)
End Sub
'bring items on top
Sub OrderToTop(layername As String)
' This example creates a SortentsTable object and
' changes the draw order of selected object(s) to top.
Dim oSset As AcadSelectionSet
Dim oEnt
Dim i As Integer
Dim setName As String
setName = "$Order$"
'Make sure selection set does not exist
For i = 0 To ThisDrawing.SelectionSets.COUNT - 1
If ThisDrawing.SelectionSets.ITEM(i).NAME = setName Then
ThisDrawing.SelectionSets.ITEM(i).DELETE
Exit For
End If
Next i
setName = "tmp_" & time()
Set oSset = ThisDrawing.SelectionSets.Add(setName)
Call selectALayer(oSset, layername)
If oSset.COUNT > 0 Then
ReDim arrObj(0 To oSset.COUNT - 1) As ACADOBJECT
'Process each object
i = 0
For Each oEnt In oSset
Set arrObj(i) = oEnt
i = i + 1
Next
End If
'kills also left over selectionset by programming mistakes....
For Each selectionset In ThisDrawing.SelectionSets
selectionset.delete_by_layer_space
Next
On Error GoTo Err_Control
'Get an extension dictionary and, if necessary, add a SortentsTable object
Dim eDictionary As Object
Set eDictionary = ThisDrawing.modelspace.GetExtensionDictionary
' Prevent failed GetObject calls from throwing an exception
On Error Resume Next
Dim sentityObj As Object
Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
On Error GoTo 0
If sentityObj Is Nothing Then
' No SortentsTable object, so add one
Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
End If
'Move selected object(s) to the top
sentityObj.MoveToTop arrObj
applicaTION.UPDATE
Exit Sub
Err_Control:
If ERR.NUMBER > 0 Then MsgBox ERR.DESCRIPTION
End Sub
Sub bringtofrontbylist()
Dim lnames As String
'predefined layer names
layer_names = "foundation bridge road"
Dim h() As String
h = split(layernames)
For i = 0 To UBound(h)
Call OrderToTop(h(i))
Next
End Sub
'in case you want a fancy form here is how to get list / all layers
Sub list_layers()
Dim LAYER As AcadLayer
For Each LAYER In ThisDrawing.LAYERS
Debug.Print LAYER.NAME
Next
End Sub
to make it run put the cursor inside the VBA IDE inside the code of list_layers andpress F5 or choose it from the VBA Macro list.
Sorry to ask such a dumb question.. but for the life of me i cant get it.. i have searched EVERYWHERE... This is a Re-Creation of my code that gives the same error. This is the most basic example i could re-create.
I dont understand why i have to declare a Label ?? (or an object)
What I am trying to accomplish is use my main form to call all the modules.
This is the FORM
'frmMain.frm
Option Explicit
Public Sub btnOpen_Click()
GetNum
End Sub
This is the MODULE
'modGet.bas
Option Explicit
Public Sub GetNum()
Dim a As String
Dim b As String
a = "hello"
b = "world"
-> Label1.Caption = a 'ERROR, Compile Error, Variable not Defined. (vb6)
Label2.Caption = b
End Sub
YES, i have a form, with a Button named 'btnOpen', i have 2 Labels named 'Label1' & 'Label2'
If i ADD..
Dim Label1 As Object 'in MODULE
i get a different error..
ERROR '91' Object Variable or With block variable not set
IF I put everything in 1 FORM, it works..(but i want to use separate modules)
I Commented out 'OPTION EXPLICIT' ... same error.
In another Test, i got the error for a TextBox..
TextBox1.Text = x
Once i get the answer for this, i can apply it for everything... I'm sure it's simple too and imma feel stupid. :-(
One of my Main Things is Querying WMI, and i get the ERROR '91' for the Label (This is in a For Each Loop) .. But its the same error, its like its makin me Declare Objects..(using Modules)
Label1.Caption = objItem.Antecedent
If Someone Could PLEASE Help me...
Use
form1.label1.caption = a
But make sure form1 is loaded
You get the error because Label1 and Label2, and your other controls for that matter do not exist in the scope of modGet.bas. They can only be referenced (the properties accessed or set), from with the form. The different error you get when you add Dim Label1 As Object is caused because an you defined Label1 as an Object, not as a Label, and an object does not have a Caption property. Unless you have a good reason for putting the GetNum sub in a .bas module move it into the form and it should work.
I modified the second example. It will modify the strings passed into it in a way that when execution passes back to the form you can assign the strings to your textboxes. I am against modifying controls on a form from another module because it goes against the idea of encapsulation.
'modGet.bas
Option Explicit
Public Function GetHello() As String
Dim strHello As String
strHello = "Hello"
GetHello = strHello
End Function
'frmMain.frm
'Option Explicit
Public Sub btnOpen_Click()
Label1.Caption = GetHello()
End Sub
Something a little different.
'MyModule.bas
Public Sub HelloWorld ByRef Value1 As String, ByVal Value2 As String)
On Error GoTo errHelloWorld
Value1 = "Hello"
Value2 = "World"
Exit Sub
errHelloWorld:
' deal with the error here
End Sub
'frmMain.frm
Option Explicit
Private Sub frmMain_Load()
Dim strText1 As String
Dim strText2 As String
HelloWorld(strText1, strText2)
Text1.Text = strText1
Text2.Text = strText2
End Sub
I also added basic error handling in the second example
I've inherited a large VB6 app at my current workplace. I'm kinda learning VB6 on the job and there are a number of problems I'm having. The major issue at the moment is I can't figure out how to check if a key exists in a Collection object. Can anyone help?
My standard function is very simple. This will work regardless of the element type, since it doesn't bother doing any assignment, it merely executes the collection property get.
Public Function Exists(ByVal oCol As Collection, ByVal vKey As Variant) As Boolean
On Error Resume Next
oCol.Item vKey
Exists = (Err.Number = 0)
Err.Clear
End Function
#Mark Biek Your keyExists closely matches my standard Exists() function. To make the class more useful for COM-exposed collections and checking for numeric indexes, I'd recommend changing sKey and myCollection to not be typed. If the function is going to be used with a collection of objects, 'set' is required (on the line where val is set).
EDIT: It was bugging me that I've never noticed different requirements for an object-based and value-based Exists() function. I very rarely use collections for non-objects, but this seemed such a perfect bottleneck for a bug that would be so hard to track down when I needed to check for existence. Because error handling will fail if an error handler is already active, two functions are required to get a new error scope. Only the Exists() function need ever be called:
Public Function Exists(col, index) As Boolean
On Error GoTo ExistsTryNonObject
Dim o As Object
Set o = col(index)
Exists = True
Exit Function
ExistsTryNonObject:
Exists = ExistsNonObject(col, index)
End Function
Private Function ExistsNonObject(col, index) As Boolean
On Error GoTo ExistsNonObjectErrorHandler
Dim v As Variant
v = col(index)
ExistsNonObject = True
Exit Function
ExistsNonObjectErrorHandler:
ExistsNonObject = False
End Function
And to verify the functionality:
Public Sub TestExists()
Dim c As New Collection
Dim b As New Class1
c.Add "a string", "a"
c.Add b, "b"
Debug.Print "a", Exists(c, "a") ' True '
Debug.Print "b", Exists(c, "b") ' True '
Debug.Print "c", Exists(c, "c") ' False '
Debug.Print 1, Exists(c, 1) ' True '
Debug.Print 2, Exists(c, 2) ' True '
Debug.Print 3, Exists(c, 3) ' False '
End Sub
I've always done it with a function like this:
public function keyExists(myCollection as collection, sKey as string) as Boolean
on error goto handleerror:
dim val as variant
val = myCollection(sKey)
keyExists = true
exit sub
handleerror:
keyExists = false
end function
As pointed out by Thomas, you need to Set an object instead of Let. Here's a general function from my library that works for value and object types:
Public Function Exists(ByVal key As Variant, ByRef col As Collection) As Boolean
'Returns True if item with key exists in collection
On Error Resume Next
Const ERR_OBJECT_TYPE As Long = 438
Dim item As Variant
'Try reach item by key
item = col.item(key)
'If no error occurred, key exists
If Err.Number = 0 Then
Exists = True
'In cases where error 438 is thrown, it is likely that
'the item does exist, but is an object that cannot be Let
ElseIf Err.Number = ERR_OBJECT_TYPE Then
'Try reach object by key
Set item = col.item(key)
'If an object was found, the key exists
If Not item Is Nothing Then
Exists = True
End If
End If
Err.Clear
End Function
As also advised by Thomas, you can change the Collection type to Object to generalize this. The .Item(key) syntax is shared by most collection classes, so that might actually be useful.
EDIT Seems like I was beaten to the punch somewhat by Thomas himself. However for easier reuse I personally prefer a single function with no private dependencies.
Using the error handler to catch cases when the key does not exists in the Collection can make debugging with "break on all errors" option quite annoying. To avoid unwanted errors I quite often create a class which has the stored objects in a Collection and all keys in a Dictionary. Dictionary has exists(key) -function so I can call that before trying to get an object from the collection. You can only store strings in a Dictionary, so a Collection is still needed if you need to store objects.
The statement "error handling will fail if an error handler is already active" is only partly right.
You can have multiple error handlers within your routine.
So, one could accommodate the same functionality in only one function.
Just rewrite your code like this:
Public Function Exists(col, index) As Boolean
Dim v As Variant
TryObject:
On Error GoTo ExistsTryObject
Set v = col(index)
Exists = True
Exit Function
TryNonObject:
On Error GoTo ExistsTryNonObject
v = col(index)
Exists = True
Exit Function
ExistsTryObject:
' This will reset your Err Handler
Resume TryNonObject
ExistsTryNonObject:
Exists = False
End Function
However, if you were to only incorporate the code in the TryNonObject section of the routine, this would yield the same information.
It will succeed for both Objects, and non-objects.
It will speed up your code for non-objects, however, since you would only have to perform one single statement to assert that the item exists within the collection.
Better solution would be to write a TryGet function. A lot of the time you are going to be checking exists, and then getting the item. Save time by doing it at the same time.
public Function TryGet(key as string, col as collection) as Variant
on error goto errhandler
Set TryGet= col(key)
exit function
errhandler:
Set TryGet = nothing
end function
see
http://www.visualbasic.happycodings.com/Other/code10.html
the implementation here has the advantage of also optionally returning the found element, and works with object/native types (according to the comments).
reproduced here since the link is no longer available:
Determine if an item exists in a collection
The following code shows you how to determine if an item exists within a collection.
Option Explicit
'Purpose : Determines if an item already exists in a collection
'Inputs : oCollection The collection to test for the existance of the item
' vIndex The index of the item.
' [vItem] See Outputs
'Outputs : Returns True if the item already exists in the collection.
' [vItem] The value of the item, if it exists, else returns "empty".
'Notes :
'Example :
Function CollectionItemExists(vIndex As Variant, oCollection As Collection, Optional vItem As Variant) As Boolean
On Error GoTo ErrNotExist
'Clear output result
If IsObject(vItem) Then
Set vItem = Nothing
Else
vItem = Empty
End If
If VarType(vIndex) = vbString Then
'Test if item exists
If VarType(oCollection.Item(CStr(vIndex))) = vbObject Then
'Return an object
Set vItem = oCollection.Item(CStr(vIndex))
Else
'Return an standard variable
vItem = oCollection.Item(CStr(vIndex))
End If
Else
'Test if item exists
If VarType(oCollection.Item(Int(vIndex))) = vbObject Then
'Return an object
Set vItem = oCollection.Item(Int(vIndex))
Else
'Return an standard variable
vItem = oCollection.Item(Int(vIndex))
End If
End If
'Return success
CollectionItemExists = True
Exit Function
ErrNotExist:
CollectionItemExists = False
On Error GoTo 0
End Function
'Demonstration routine
Sub Test()
Dim oColl As New Collection, oValue As Variant
oColl.Add "red1", "KEYA"
oColl.Add "red2", "KEYB"
'Return the two items in the collection
Debug.Print CollectionItemExists("KEYA", oColl, oValue)
Debug.Print "Returned: " & oValue
Debug.Print "-----------"
Debug.Print CollectionItemExists(2, oColl, oValue)
Debug.Print "Returned: " & oValue
'Should fail
Debug.Print CollectionItemExists("KEYC", oColl, oValue)
Debug.Print "Returned: " & oValue
Set oColl = Nothing
End Sub
See more at: https://web.archive.org/web/20140723190623/http://visualbasic.happycodings.com/other/code10.html#sthash.MlGE42VM.dpuf
While looking for a function like this i designed it as following.
This should work with objects and non-objects without assigning new variables.
Public Function Exists(ByRef Col As Collection, ByVal Key) As Boolean
On Error GoTo KeyError
If Not Col(Key) Is Nothing Then
Exists = True
Else
Exists = False
End If
Exit Function
KeyError:
Err.Clear
Exists = False
End Function