In CATIAV5 R26, I'm trying to dump the CATSettings related to the General --> Document tab to catvbs.
Consider that this should be a first step towards my final objective: fully automate settings with macros, as it is suggested in the official docs (http://www.maruf.ca/files/caadoc/CAAScdInfTechArticles/CAAInfSettings.htm)
I expect the dump function to create a catvbs containing ALL the settings of this tab, but instead, ONLY the DLName settings are written: the result is a General-Document.catvbs containing only the settings from CATSysDLNameSettingCtrl
The majority of settings, for example those inside the "Document Environment" or "Linked Documents Localization" sections (see image below) are not exported.
Is this inteded? Is this a bug? How can I be sure to have ALL settings exported to catvbs?
CATSettings Tab
Dumped General-Document.catvbs
Language="VBSCRIPT"
Sub CATMain()
Set settingControllers1 = CATIA.SettingControllers
Set dLNameSettingAtt1 = settingControllers1.Item("CATSysDLNameSettingCtrl")
Dim boolean1
boolean1 = dLNameSettingAtt1.DLNameCreationRight
'--------------------------------------------------
' Returned value : (Boolean) True
'--------------------------------------------------
Dim bSTR1
bSTR1 = ""
Dim bSTR2
bSTR2 = ""
Dim boolean2
boolean2 = dLNameSettingAtt1.GetDLNameCreationRightInfo(bSTR1, bSTR2)
'--------------------------------------------------
' Parameter 1 : (String) "Set at Admin Level 1"
' Parameter 2 : (String) "Locked at Admin Level 1"
' Returned value : (Boolean) False
'--------------------------------------------------
Dim boolean3
boolean3 = dLNameSettingAtt1.RootDLNameCreationRight
'--------------------------------------------------
' Returned value : (Boolean) True
'--------------------------------------------------
Dim bSTR3
bSTR3 = ""
Dim bSTR4
bSTR4 = ""
Dim boolean4
boolean4 = dLNameSettingAtt1.GetRootDLNameCreationRightInfo(bSTR3, bSTR4)
'--------------------------------------------------
' Parameter 1 : (String) "Default value"
' Parameter 2 : (String) "Unlocked"
' Returned value : (Boolean) False
'--------------------------------------------------
Dim arrayOfVariantOfBSTR1
arrayOfVariantOfBSTR1 = dLNameSettingAtt1.GetDLNameList()
'--------------------------------------------------
' Returned value : (Array)
' Array[0] : (Variant) (String) "My Sample DL Name"
'--------------------------------------------------
Dim bSTR5
bSTR5 = ""
Dim bSTR6
bSTR6 = ""
Dim bSTR7
bSTR7 = ""
dLNameSettingAtt1.GetDLName "My Sample DL Name", bSTR5, bSTR6, bSTR7
'--------------------------------------------------
' Parameter 1 : (String) "My Sample DL Name"
' Parameter 2 : (String) "/tmp/here"
' Parameter 3 : (String) "${MY_SAMPLE_VAR}"
' Parameter 4 : (String) ""
'--------------------------------------------------
Dim bSTR8
bSTR8 = ""
Dim bSTR9
bSTR9 = ""
Dim boolean5
boolean5 = dLNameSettingAtt1.GetDLNameInfo("My Sample DL Name", bSTR8, bSTR9)
'--------------------------------------------------
' Parameter 1 : (String) "My Sample DL Name"
' Parameter 2 : (String) "Set at Admin Level 1"
' Parameter 3 : (String) "Unlocked"
' Returned value : (Boolean) False
'--------------------------------------------------
End Sub
My mistake, I misunderstood your question. I would delete myself this answer but I it seems I cannot do it.
For your case it seems only DLNames is allowed and I suppose you will get only that catvbs.
If you want all catvbs for all catsettings then you need to do what is in picture bellow (see red arrow).
I'm afraid that not all the CATSettings are exposed to automation (as gdir correctly pointed out), including those I'm looking for.
as you can see in the documentation (emphasis mine)
In addition to using the Tools->Options... command, many settings can
be managed and administrated using Automation ...
many, not all.
This sadly prevents the full automation of CATSettings, as far as I know.
Related
Catia V5 R24
1) is there any way to check by the VBA code if the parameter in catia is locked ?
2) Is there any way to check by the VBA code if the value of the parameter is set from the KWA rule ?
What I'm going to do:
I will have a Catia Part with necessary geometry, parameters and rules in KWA.
I will add only in VBA window where user can easily edit and modify a geometry.
Below You can find a sample How it will looks like
User Will chose a method for the calculation parameter (3 and 4)
if he will chose 1st (script will check if the parameter in PRT file has a lock status, and if it is set from the KWA Rule) if yes than script should change a window option (Enabled > False, disable a posililiby to put any values to this window), and Enable button 2
I know that there will be more problems with this window, but I will try to solve them one by one.
Here is my test code
Private Sub cmdClose_Click()
Call ChangeValue("Show_Window", "No")
Me.Hide
'End
End Sub
Public Sub Start_Click()
On Error Resume Next
Set curDoc = CATIA.ActiveDocument
Set mySel = curDoc.Selection
mySel.Search "Name= 'xy plane', in"
If TypeName(curDoc) = "PartDocument" Then Set curPrt = curDoc.Part
If TypeName(curDoc) = "ProductDocument" Then Set curPrt = mySel.FindObject("CATIAPart")
Set ihybBodies = curPrt.HybridBodies
Set ihybBody = curPrt.InWorkObject
Dim iPars As Parameters: Set iPars = curPrt.Parameters
Dim iPar As Parameter
'search parameters length
mySel.Clear: mySel.Add ihybBody: mySel.Search "Name=Length_Param,in"
Set iPar = mySel.Item2(1).Value: LengthParam = iPar.Value & " mm"
'search parameters length 2nd method
Set iPar = Parameters.Item("Length_Param").Value: Length2ndMethod = iPar.Value & " mm"
'check lock status
Dim myLockStatus As Boolean
myLockStatus = Parameters.LockStatus("Length_Param").Lock
MsgBox myLockStatus
'---------------------------------------------------------------------------------------------------------
'search string
mySel.Clear: mySel.Add ihybBody: mySel.Search "Name=String Param,in"
Set iPar = mySel.Item2(1).Value: StringParam = iPar.Value
'---------------------------------------------------------------------------------------------------------
'search ListBox
mySel.Clear: mySel.Add ihybBody: mySel.Search "Name=String_List,in"
Set iPar = mySel.Item2(1).Value
'Clear List
ListBox.Clear
'Add Items to list from CADPRT
cnt = iPar.GetEnumerateValuesSize
Dim ParamValues() As Variant
ReDim ParamValues(cnt)
iPar.GetEnumerateValues ParamValues
For i = 0 To cnt - 1
With ListBox
.AddItem ParamValues(i)
End With
Next
'set value from PRT
ListBox = iPar.Value
'---------------------------------------------------------------------------------------------------------
End Sub
I have been working on a quickbooks project and have been successful on many aspects until I hit a wall at attempting to add a Purchase Order.
as the title states I am using the QBFC -has anyone successfully accomplished this and could point me in the right direction ?
I am currently using mostly example code from the OnScreen reference from quickbooks ( before customizing it) a process which I have used for the other aspects of what I already have working...
It runs fine, but currenrtly doesn't actally add anything to the Quickbooks vendor?
thanks in advance
` Public Sub writePO_ToQB()
Dim sessManager As QBSessionManager
Dim msgSetRs As IMsgSetResponse
sessManager = New QBSessionManagerClass()
Dim msgSetRq As IMsgSetRequest = sessManager.CreateMsgSetRequest("US", 13, 0)
msgSetRq.Attributes.OnError = ENRqOnError.roeContinue
MessageBox.Show("calling write command")
writeActualQBMSG(msgSetRq)
'step3: begin QB session and send the request
sessManager.OpenConnection("App", "DataBridge JBOOKS")
sessManager.BeginSession("", ENOpenMode.omDontCare)
msgSetRs = sessManager.DoRequests(msgSetRq)
End Sub
Public Sub writeActualQBMSG(requestMsgSet As IMsgSetRequest)
' Dim requestMsgSet As IMsgSetRequest
Dim PurchaseOrderAddRq As IPurchaseOrderAdd
PurchaseOrderAddRq = requestMsgSet.AppendPurchaseOrderAddRq()
'add all the elements of a PO to the request - need to determine what is required!!
' PurchaseOrderAddRq.VendorRef.FullName.SetValue("Test Vendor")
PurchaseOrderAddRq.VendorRef.ListID.SetValue("80000094-1512152428")
'------------------- CODE FROM QBS --------
Dim ORInventorySiteORShipToEntityElementType162 As String
ORInventorySiteORShipToEntityElementType162 = "InventorySiteRef"
If (ORInventorySiteORShipToEntityElementType162 = "InventorySiteRef") Then
'Set field value for ListID
PurchaseOrderAddRq.ORInventorySiteORShipToEntity.InventorySiteRef.ListID.SetValue("200000-1011023419")
'Set field value for FullName
PurchaseOrderAddRq.ORInventorySiteORShipToEntity.InventorySiteRef.FullName.SetValue("ab")
End If
If (ORInventorySiteORShipToEntityElementType162 = "ShipToEntityRef") Then
'Set field value for ListID
PurchaseOrderAddRq.ORInventorySiteORShipToEntity.ShipToEntityRef.ListID.SetValue("200000-1011023419")
'Set field value for FullName
PurchaseOrderAddRq.ORInventorySiteORShipToEntity.ShipToEntityRef.FullName.SetValue("ab")
End If
' ----------------- END OF CODE FROM QBS --------------------------------------------
'------------ MOR QBS CODE ------------
Dim ORPurchaseOrderLineAddListElement324 As IORPurchaseOrderLineAdd
ORPurchaseOrderLineAddListElement324 = PurchaseOrderAddRq.ORPurchaseOrderLineAddList.Append()
Dim ORPurchaseOrderLineAddListElementType325 As String
ORPurchaseOrderLineAddListElementType325 = "PurchaseOrderLineAdd"
If (ORPurchaseOrderLineAddListElementType325 = "PurchaseOrderLineAdd") Then
'Set field value for ListID
' ORPurchaseOrderLineAddListElement324.PurchaseOrderLineAdd.ItemRef.ListID.SetValue("200000-1011023419")
'Set field value for FullName
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineAdd.ItemRef.FullName.SetValue("granite")
'Set field value for ManufacturerPartNumber
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineAdd.ManufacturerPartNumber.SetValue("123456789")
'Set field value for Desc
' ORPurchaseOrderLineAddListElement324.PurchaseOrderLineAdd.Desc.SetValue("ab")
'Set field value for Quantity
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineAdd.Quantity.SetValue(2)
Dim DataExt326 As IDataExt
DataExt326 = ORPurchaseOrderLineAddListElement324.PurchaseOrderLineAdd.DataExtList.Append()
'Set field value for OwnerID
' DataExt326.OwnerID.SetValue(System.Guid.NewGuid().ToString())
DataExt326.OwnerID.SetValue(0)
'Set field value for DataExtName
DataExt326.DataExtName.SetValue("ab")
'Set field value for DataExtValue
DataExt326.DataExtValue.SetValue("ab")
End If
If (ORPurchaseOrderLineAddListElementType325 = "PurchaseOrderLineGroupAdd") Then
'Set field value for ListID
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.ItemGroupRef.ListID.SetValue("200000-1011023419")
'Set field value for FullName
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.ItemGroupRef.FullName.SetValue("ab")
'Set field value for Quantity
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.Quantity.SetValue(2)
'Set field value for UnitOfMeasure
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.UnitOfMeasure.SetValue("ab")
'Set field value for ListID
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.InventorySiteLocationRef.ListID.SetValue("200000-1011023419")
'Set field value for FullName
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.InventorySiteLocationRef.FullName.SetValue("ab")
Dim DataExt327 As IDataExt
DataExt327 = ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.DataExtList.Append()
'Set field value for OwnerID
DataExt327.OwnerID.SetValue(System.Guid.NewGuid().ToString())
'Set field value for DataExtName
DataExt327.DataExtName.SetValue("ab")
'Set field value for DataExtValue
DataExt327.DataExtValue.SetValue("ab")
End If
' ----- END OF MORE QBS CODE ----------
End Sub`
The issue here is you have not included the error and response handling code. You need to have something equivalent to the WalkPurchaseOrderAddRs(responseMsgSet). Specifically within that function this checks for error conditions. I have a modified version of their sample.
For j=0 To responseList.Count - 1
Dim response As IResponse
response = responseList.GetAt(i)
'check the status code of the response
If response.StatusCode = 0 Then
' response is ok, handle results as usual...
ElseIf response.StatusCode = 1 Then
' Used when search results return nothing...
Else ' > 1 Is an error
' Is an error or warning condition...
' Capture code and message from QuickBooks
Dim code As String = response.StatusCode
Dim severity As String = response.StatusSeverity ' ERROR or WARNING
Dim message As String = response.StatusMessage
End If
Next j
As a side note, the OSR sample code really is just for illustration purposes. This and similar code is pointless.
Dim ORInventorySiteORShipToEntityElementType162 As String
ORInventorySiteORShipToEntityElementType162 = "InventorySiteRef"
If (ORInventorySiteORShipToEntityElementType162 = "InventorySiteRef") Then
One more hint. When you are setting values from lists like Vendor or ItemRef, you can choose the ListID or the FullName. If you use both as the sample shows then the ListID is used by QuickBooks. I recommend you use the FullName and scrap the ListID. The reason is QuickBooks will parrot whatever you use back to you in an error message. So if your vendor doesn't exist you will either see something like "missing element 80000094-1512152428" or "missing element TheFullName" which is cryptic but readable.
Ok, one more... The sample code that appears to set the custom field data DataExt... will not work. You need to use the DataExtAdd request instead.
I am doing some customization of block insertion in Autocad. When setting up the attributes, I am getting an error in my procedure:
"Invalid argument Tag in setting TagString"
The code is as follows:
Sub Ch10_GettingAttributes()
' Create the block
Dim blockObj As AcadBlock
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 0
insertionPnt(1) = 0
insertionPnt(2) = 0
Set blockObj = ThisDrawing.Blocks.Add _
(insertionPnt, "TESTBLOCK")
' Define the attribute definition
Dim attributeObj As AcadAttribute
Dim height As Double
Dim mode As Long
Dim prompt As String
Dim insertionPoint(0 To 2) As Double
Dim tag As String
Dim value As String
height = 1#
mode = acAttributeModeVerify
prompt = "Attribute Prompt"
insertionPoint(0) = 5
insertionPoint(1) = 5
insertionPoint(2) = 0
tag = "Attribute Tag"
value = "Attribute Value"
' Create the attribute definition object on the block
Set attributeObj = blockObj.AddAttribute(height, mode,_
prompt, insertionPoint, tag, value)
End Sub
What would cause this error?
Well, the error message is rather explicit, you have an "Invalid argument Tag in setting TagString"
So simply get rid of space in the tag value and you should be good to go. It doesn't support spaces.
tag = "Attribute Tag" 'BAD
tag = "AttributeTag" 'OK
I've stumbled upon a compile error, but don't get what can be of the issue. When trying to chagne the symbol to an input variable ( TickerID ) I get the error, works perfectly fine otherwise when inputting e.g "yhoo" for the yahoo ticker name.
Code
Private Sub CmdBtn_Add_Click()
'---------------------------------------------------------------------------------------'
' Checks that inputted ticker name is correct and calls import class after confirmation
'---------------------------------------------------------------------------------------'
' General Variables---------'
Dim TickerID As String: TickerID = UCase(Add_Instrument.TxtBox_Instrument.Value)
'--------------------------'
'Check if input field is not empty
If TickerID = "" Or Application.WorksheetFunction.IsText(TickerID) = False Then
MsgBox "Please provide a valid ticker ID"
Exit Sub
End If
Debug.Print TickerID
'Check Ticker name exists through YQLBuilder class
Dim YQLBuilder As YQLBuilder: Set YQLBuilder = New YQLBuilder
Call YQLBuilder.TickerCheck(TickerID)
' Call ImportData(TickerID)
' MsgBox "Please check the ticker name. It is in the wrong format"
End Sub
Public Sub TickerCheck(TickerID As String)
'---------------------------------------------------------------------------------------'
' Built 2014-11-05 Allows parsing of XML data through YAHOO API YQL
' 2014-12-21: Not fully built yet, see where it can be of use
'---------------------------------------------------------------------------------------'
' General Variables---------'
Const ConnStringStart As String = "http://query.yahooapis.com/v1/public/yql?q="
Const ConnStringLast As String = "&diagnostics=true&env=store://datatables.org/alltableswithkeys"
'---------------------------'
Const ConnStringInput As String = "select * from yahoo.finance.stocks where symbol='" _
& TickerID & "'" **<----- Error here!**
Debug.Print ConnStringStart & ConnStringInput & ConnStringLast
Dim YQLNodes As MSXML2.IXMLDOMNodeList
Dim YQLReq As MSXML2.DOMDocument60
Set YQLReq = New MSXML2.DOMDocument60
YQLReq.async = False
YQLReq.Load ConnStringStart & ConnStringInput & ConnStringLast
YQLReq.setProperty "SelectionNamespaces", "xmlns:f='http://www.yahooapis.com/v1/base.rng'"
Set YQLNodes = YQLReq.SelectNodes("//CompanyName")
Dim xNode As MSXML2.IXMLDOMNode
For Each xNode In YQLNodes
Debug.Print xNode.Text
Next xNode
Debug.Print YQLNodes.Length
End Sub
The message is clear. When you declare a constant, the value you give it must be constant too. In this case, part of it is the parameter TickerId, which is variable. You cannot declare a constant with a variable value.
To solve this, I think you could just use Dim instead of Const and not make ConnStringInput a constant at all.
Self teaching VB beginner here.
I have a data entry section that includes...
2 comboboxes(cbx_TruckType, cbx_DoorNumber)
-------cbx_TruckType having 2 options (Inbound, Outbound)
-------cbx_DoorNumber having 3 options (Door 1, Door 2, Door 3)
2 textboxes (txb_CustomerName, txb_OrderNumber)
-------txb_CustomerName will hold a customer name
-------txb_OrderNumber will hold an order number
and finally...
a button(btn_EnterTruck) that transfers the text from the comboxes and textboxes to the following...
2 Tabs
The 1st tab has
2 buttons(btn_Door1, btn_Door2)
btn_Door1 has 3 corresponding textboxes
-------txb_TruckTypeDoor1, txb_CustomerNameDoor1, txb_OrderNumberDoor1
btn_Door2 has 3 corresponding textboxes
-------txb_TruckTypeDoor2, txb_CustomerNameDoor2, txb_OrderNumberDoor2
The 2nd tab has
1 button(btn_Door3)
btn_Door1 has 3 corresponding textboxes
-------txb_TruckTypeDoor3, txb_CustomerNameDoor3, txb_OrderNumberDoor3
Currently, I have code (that works thanks to another question I had!) that, upon btn_EnterTruck.click, will transfer the text to the corresponding textboxes.
Here's my problem...
I've coded a msgbox to pop-up (when Inbound is selected from the cbx_TruckType) asking if there is an Outbound. If I click "Yes", an inputbox pops-up and asks for an order number. The button then transfers the Inbound information to the textboxes and stores the Outbound order number.
When I click btn_Door1(or 2 or 3), it clears the text from its corresponding textboxes. (Using me.controls)
( I would add code for all of the above, but I figure its a moot point, because it works)
What I want to happen...
I want to have the stored Outbound number to be saved with a reference to which door number it corresponds to. Then upon btn_DoorX click, it will fill that order number into the corresponding textbox. I don't need the text stored/saved when the app is closed.
And I have no idea how to do that.
*After some tooling, I've done the following, but it does not work"
I declared these at the class level.
Dim str_SameTruckPODoor1, str_SameTruckPODoor2, str_SameTruckPODoor3 As String
This code is in the btn_EnterTruck event
Dim str_ErrOutDoorName As String = cbx_DoorNumber.Text
Dim str_OutboundDoorName As String = str_ErrOutDoorName.Replace(" ", "")
Dim ArrayForPONumbers As Control() = Me.Controls.Find("str_SameTruckPO" & str_OutboundDoorName, True)
If cbx_TruckType.Text = "Inbound" Then
Dim OutboundMsg = "Is there an Outbound with this truck information?"
Dim Title = "Outbound?"
Dim style = MsgBoxStyle.YesNo Or MsgBoxStyle.DefaultButton2 Or _
MsgBoxStyle.Question
Dim response = MsgBox(OutboundMsg, style, Title)
If response = MsgBoxResult.Yes Then
Dim NeedPOMessage, NeedPOTitle, defaultValue As String
Dim PONumberOutbound As String
' Set prompt.
NeedPOMessage = "Enter the PO Number"
' Set title.
NeedPOTitle = "PO# For Outbound"
defaultValue = "?" ' Set default value.
' Display message, title, and default value.
PONumberOutbound = InputBox(NeedPOMessage, NeedPOTitle, defaultValue)
' If user has clicked Cancel, set myValue to defaultValue
If PONumberOutbound Is "" Then PONumberOutbound = defaultValue
ArrayForPONumbers(0) = PONumberOutbound
End If
End If
I'm getting an error message on
ArrayForPONumbers(0) = PONumberOutbound ' Cannot convert string to .controls
And I have the following code in the btn_Door1 event - it handles btn_Door2, btn_Door3
Dim WhichButton As Button = CType(sender, Button)
Dim str_ErrDoorName As String = WhichButton.Name
Dim str_DoorName As String = str_ErrDoorName.Replace("btn_", "")
Dim str_DoorType As Control() = Me.Controls.Find("txb_" & str_DoorName & "Type", True)
Dim str_Customer As Control() = Me.Controls.Find("txb_" & str_DoorName & "Customer", True)
Dim str_OrderNumber As Control() = Me.Controls.Find("txb_" & str_DoorName & "OrderNumber", True)
Dim SecondArrayForPONumbers As Control() = Me.Controls.Find("str_SameTruckPO" & str_DoorName, True)
If str_DoorType(0).Text = "Outbound" Then
str_DoorType(0).Text = ""
str_Customer(0).Text = ""
str_OrderNumber(0).Text = ""
ElseIf SecondArrayForPONumbers(0).Text.Length > 0 Then
str_DoorType(0).Text = "Outbound"
str_OrderNumber(0).Text = Me.Controls("str_SameTruckPO" & str_DoorName).Text
End If
Any help is appreciated. If I'm not clear on what I'm asking or haven't given enough details, please let me know.
Edit: Added info based on comment, Added code, Changed Title
How long do you want this data to be stored? IE: longer than the life of the open application? If the application is closed is it alright if the data is lost? If not, you may want to consider writing this data to an external database.