I am trying to get the length of user selected lines/splines
This is the code I'm using to have users select their lines:
Dim USel As Selection
Dim USelLB
Dim InputObject(0)
InputObject(0) = "AnyObject"
Set USel = CATIA.ActiveDocument.Selection
Set USelLB = USel
USel.Clear
USelLB.Clear
Linestomeasure = USelLB.SelectElement3(InputObject, "Select objects to list names", True, CATMultiSelTriggWhenUserValidatesSelection, False)
Linestomeasure is a public variable, in the mainsub i've been trying to measure Linestomeasure using the following code:
Dim pd1 As PartDocument
Dim a As Object
Dim c As Reference
a = TrimLines.Item(1)
c = pd1.Part.CreateReferenceFromObject(a)
Dim Mea1 As Measurable
Dim TheSPAWorkbench As SPAWorkbench
Set TheSPAWorkbench = pd1.GetWorkbench("SPAWorkbench")
Set Mea1 = TheSPAWorkbench.GetMeasurable(c)
But when I run the code a = trimLines.Item(1) gets highlighted in the debugger with the error message "Object Required".
Does anyone have an idea on how I can change my code so that I can get the length of the line as a variable that I can work with ? Or just a different way to go about what I'm trying to do?
Edited answer to reflect comment bellow
Looks like you are assigning the wrong type of variable to the USelLB.SelectElement3 and also missunderstanding how it actually works.
The Selection.SelectElement3 returns a String that reflects whether the selection was sucessfull or not.
The Object retrieved from the Selection is inside the Selection.Item(Index)
Your code should be something like this:
Dim PD1 as PartDocument
Dim Sel 'as Selection 'Sometimes it is needed to comment the selection to use the .SelectElement3 method
Dim InputObjType(0)
Dim SelectionResult as string
Dim LineToMeasure as AnyObject
Dim I as Integer
Dim SpaWorkbench as SPAWorkbench
Dim Measurable as Measurable
InputObjType(0) = "AnyObject"
'set PD1 = Catia.ActiveDocument
set Sel = PD1.Selection
Set TheSPAWorkbench = pd1.GetWorkbench("SPAWorkbench")
Sel.Clear
SelectionResult= Sel.SelectElement3(InputObject, "Select objects to list names", True, CATMultiSelTriggWhenUserValidatesSelection, False)
If SelectionResult = "Ok" or SelectionResult = "Normal" then 'Check if user did not cancel the Selection
For i = 1 to Selection.Count
Set LineToMeasure = Sel.Item(i).Value
set Measurable = SpaWorkbench.GetMeasurable(LineToMeasure)
'Measure whatever you need here.
Next
End If
Keep in mind that using the AnyObject type filter may cause the user to select unwanted objects. You shoudl use a more specific filter.
Related
I am trying to search, select and delete all geometry (points, lines, ...) inside one specific sketch.
I can't find the right search command. It either selects all geometry of the entire part, which I don't want or nothing at all.
You need to select first the desired sketch, either by user choice or by searching after name and after that you need to search inside this selection the 2D geometry (with an advanced query you can select and delete whatever you want).
If you are still looking for answer try this code:
Sub CATMain()
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")
Dim sketches1 As Sketches
Set sketches1 = hybridBody1.HybridSketches
Dim sketch1
Set sketch1 = sketches1.Item("Sketch.1")
Dim factory2D1 As Factory2D
Set factory2D1 = sketch1.OpenEdition()
Dim geometricElements1 As GeometricElements
Set geometricElements1 = sketch1.GeometricElements
While geometricElements1.Count > 1
If geometricElements1.Item(geometricElements1.Count).GeometricType <> catGeoTypeAxis2D Then
Dim Geometry2D
Set Geometry2D = geometricElements1.Item(geometricElements1.Count)
Set objHSF = part1.HybridShapeFactory
Set objRef = part1.CreateReferenceFromObject(Geometry2D)
objHSF.DeleteObjectForDatum objRef
End If
Wend
sketch1.CloseEdition
part1.Update
End Sub
But be careful, deleting all the geometry with the code will not delete the sketch!
You cannot have a empty sketch in Catia. Leaving it empty can cause various problems.
I know similar questions have been asked before like this and this
but I was having issues with initializing the checkbox array object (My VBA is quite rusty).
I have the following code:
Dim chkAdQ(4) As Checkbox
Set chkAdQ(0) = chkAdQ1
Set chkAdQ(1) = chkAdQ2
Set chkAdQ(2) = chkAdQ3
Set chkAdQ(3) = chkAdQ4
where chkAdQ1, chkAdQ2 etc. are ActiveX checkboxes present on the form. On debugging I can see that chkAdQ(4) prompts 'nothing' on the declaration itself and hence the assignment gives a Type mismatch exception.
I also tried by declaring chkAdQ(4) as an Object but to no avail. Any thoughts?
You can add all checkboxes on the worksheet quite nicely with a simple loop
Sub AddCheckBoxesToArray()
Dim chkAdQ As Variant
Dim cb
i = 0
ReDim chkAdQ(i)
For Each cb In Sheet2.OLEObjects
If TypeName(cb.Object) = "CheckBox" Then
If i > 0 Then ReDim Preserve chkAdQ(0 To i)
Set chkAdQ(i) = cb
i = i + 1
End If
Next cb
For Each cb In chkAdQ
Debug.Print cb.Name
Next cb
End Sub
Remove the second loop when using. This is just to prove that they have all been added by printing their names to the Immediate window
Try this
Dim chkAdQ(0 To 3) As Variant
Set chkAdQ(0) = chkAdQ1
Set chkAdQ(1) = chkAdQ2
Set chkAdQ(2) = chkAdQ3
Set chkAdQ(3) = chkAdQ4
I have a slicer called 'Slicer_HeaderTitle'. I simply need to be able to dim a variable in VBA with the value of the selected element. I'll only have one element selected at a time.
I've had a lot of problems with selecting and de-selecting elements from my slicer dynamically via VBA, since my pivot table is connected to an external data-source. I don't know if this is relevant for this exact example, but this table is connected to the same external data-source.
I used to have a single line of code, which could return this value, but all i could find now requires you loop through each element in the slicer and check if it's selected or not. I hope to avoid this, since I only have 1 selected element at a time.
' This is what I'm trying to achieve.
Dim sValue as String
sValue = ActiveWorkbook.SlicerCaches("Slicer_HeaderTitle").VisibleSlicerItems.Value
msgbox(sValue)
'Returns: "Uge 14 - 2016 (3. Apr - 9. Apr)"
Current Status:
This is what i did:
Public Function GetSelectedSlicerItems(SlicerName As String) As String
Dim SL As SlicerCacheLevel
Dim sI As SlicerItem
Set SL = ActiveWorkbook.SlicerCaches(SlicerName).SlicerCacheLevels(1)
For Each sI In SL.SlicerItems
If sI.Selected = True Then
GetSelectedSlicerItems = (sI.Value)
End If
Next
End Function
Dim sValue As String
sValue = GetSelectedSlicerItems("Slicer_HeaderTitle")
Thanks to Doktor OSwaldo for helping me a lot!
Ok to find the error, we will take a step back, delete my function and try Looping through the items:
Dim sC As SlicerCache
Dim SL As SlicerCacheLevel
Dim sI As SlicerItem
Set sC = ActiveWorkbook.SlicerCaches("Slicer_Dates_Hie")
Set SL = sC.SlicerCacheLevels(1)
For Each sI In SL.SlicerItems
sC.VisibleSlicerItemsList = Array(sI.Name)
Next
I would like to put in my two cents. The set of visible slicer items may be shrunk by both independent actions:
User selection of items in slicer A. To capture those items, use .Selected method.
Selection of items in slicer B which in consequence shrinks the list of slicer A items. To capture those items, use .HasData method.
Note that you may see only say two items of Slicer_Products (apples, bananas) because some other slicer Slicer_Product_Type has active filter on fruits. The method sI.Selected would still return the whole list of products apples, bananas, carrots...
If you want both limitations to be in place then make intersection of both sets. I have modified TobiasKnudsen code (excellent answer!) to return the list of items shrunk by both above limitations. If sI.Selected = True And sI.HasData = True Then is the key line in this code.
Option Explicit
Sub TestExample()
Dim MyArr() As Variant
MyArr = ArrayListOfSelectedAndVisibleSlicerItems("Slicer_A")
'now variable MyArr keeps all items in an array
End Sub
Public Function ArrayListOfSelectedAndVisibleSlicerItems(MySlicerName As String) As Variant
'This function returns an array of the limited set of items in Slicer A
'Limitation is due to both:
'(1) direct selection of items by user in slicer A
'(2) selection of items in slicer B which in consequence limits the number of items in slicer A
Dim ShortList() As Variant
Dim i As Integer: i = 0 'for iterate
Dim sC As SlicerCache
Dim sI As SlicerItem 'for iterate
Set sC = ThisWorkbook.Application.ActiveWorkbook.SlicerCaches(MySlicerName)
For Each sI In sC.SlicerItems
If sI.Selected = True And sI.HasData = True Then 'Here is the condition!!!
'Debug.Print sI.Name
ReDim Preserve ShortList(i)
ShortList(i) = sI.Value
i = i + 1
End If
Next sI
ArrayListOfSelectedAndVisibleSlicerItems = ShortList
End Function
Sub Demo()
Dim i As Integer
With ActiveWorkbook.SlicerCaches("Slicer_Country")
For i = 1 To .SlicerItems.Count
If .SlicerItems(i).Selected Then
Sheets("Pivot Sheet").Range("I" & i) = SlicerSelections & " " & .SlicerItems(i).Value
End If
Next i
End With
End sub
This is how I managed to identify the selected element on a slicer.
The answer by TobiasKnudsen above did not work for me as I got an error stating the data source needed to be an OLAP source.
My data is an excel table and this is the code that worked:
Dim val as Boolean
val = ThisWorkbook.SlicerCaches("Slicer_MYSLICER").VisibleSlicerItems.Item("CS").HasData
In my case, the slicer had only 3 items so I repeated the line above with a different string in item()
So, where val was true, that was the item that was currently selected.
I have a 2D chart in Excel. I need to get the value of a cell using two string variables. The chart looks like this:
Document person1 person2
Text1 5 8
Text2 2 1
Text3 9 6
After looking online I am finding this difficult because:
the values are strings, not integers;
the strings will change depending on which person and document combination comes up.
This should be the only code that is relevant:
Dim document as string
Dim person as string
Dim oExcel as excel.application
Dim oWB as workbook
Set oExcel = New Excel.application
Set oWB = oExcel.Workbooks.open. ("C:")
oExcel.Visible = True
oWB.Sheets ("sheet1").Cells(documemt, person)
Assuming that document and person are string variables that hold string representations of integers (e.g. document = "1", person = "2") then something like
oWB.Sheets ("sheet1").Cells(val(document), val(person))
will work. If the contents of the string variables are more complicated then you would need to do some parsing of those strings.
Assuming by "2d Chart" you mean a table in a Worksheet, and that person would be the full text "person1", or "person2", etc. and likewise for document, then perhaps this function will do the trick.
Function FindDocPerson(person As String, document As String) As Variant
Const MatchExact As Integer = 0
Dim ws As Excel.Worksheet
Set ws = ActiveWorkbook.Worksheets("Sheet1")
Dim table As Excel.Range
Set table = ws.UsedRange
Dim docRange As Excel.Range
Set docRange = table.Columns(1).Offset(1, 0).Resize(table.Columns(1).Rows.Count - 1)
Dim personRange As Excel.Range
Set personRange = table.Rows(1).Offset(0, 1).Resize(1, table.Columns.Count - 1)
Dim personIndex As Long
Dim docIndex As Long
On Error GoTo errHandler
personIndex = Application.WorksheetFunction.Match(person, personRange, MatchExact) + 1
docIndex = Application.WorksheetFunction.Match(document, docRange, MatchExact) + 1
FindDocPerson = table.Cells(docIndex, personIndex).Value2
Exit Function
errHandler:
FindDocPerson = VBA.CVErr(Excel.xlErrNA)
End Function
calling syntax:
Dim result As Variant
result = FindDocPerson("person2", "text1")
If Application.WorksheetFunction.IsError(result) Then
' handle it
Else
' found it
End If
There is a typo in your code,
oWB.Sheets ("sheet1").Cells(documemt, person)
documemt should be document
All that aside though it is unclear what you want to do, can you give a little more description please?
All we know is you need to get the value of a cell using two string variables and that it could be a string or a number. The code you posted doesn't give much more of a hint to your goal.
To convert between strings and numbers you can use CLng to convert to a long number or CStr to convert to a string. eg CLng("3") = 3 and CStr(3) = "3"
In your code this:
Set oWB = oExcel.Workbooks.open. ("C:")
Doesn't work because you are trying to open a workbook without specifying a name, I also note the ("C:") is spaced far to the right of the command call which leads me to believe this is has been typed freestyle ie not in the VBE. This makes it even harder to decode into your requirements.
Lastly, this code:
Set oExcel = New Excel.application
Why are you starting another session of Excel from Excel VBA code? Is this code somewhere other than Excel ie Outlook / Access / PowerPoint / Word / Business Objects etc etc.
I'm still learning VBA and I can't figure out wth I'm having so many problems with a Collections object.
I have a function that adds custom objects (I created a very simple class to store some data) that does the typical "read data, create object representation, stick it into Collections" sort of stuff.
If I try to add a "key" to the bag.add call I get a "Compile error. Expected:=" message.
If I don't it appears to have worked then when I run the program it says "Compile Error. Argument not optional" and highlights the "getRevColumns = bag" line.
I can't for the life of me figure out wth is going on! I suspect something wrong with how I initialized my bag?! PS: columnMap is the name of my custom class.
Function getRevColumns() As Collection
Dim rng As Range
Dim i As Integer
Dim bag As Collection
Dim opManCol As Integer, siebelCol As Integer
Dim opManColName As String, siebelColName As String
Dim itm As columnMap
Set bag = New Collection
Set rng = shSiebelMap.UsedRange.Columns(5)
i = 1
For i = 1 To rng.Rows.count
If StrComp(UCase(rng.Cells(i).value), "Y") = 0 Then
opManCol = rng.Rows(i).OffSet(0, -2).value
opManColName = rng.Rows(i).OffSet(0, -4)
siebelCol = rng.Rows(i).OffSet(0, -1).value
siebelColName = rng.Rows(i).OffSet(0, -3)
Set itm = New columnMap
itm.opManColName = opManColName
itm.opManColNumber = opManCol
itm.siebelColName = siebelColName
itm.siebelColNumber = siebelCol
'WHY DOESN'T IT WORK!''
bag.Add (itm)
'MsgBox "opMan Col: " & opManColName & " : " & opManCol & ". Siebel Col: " & siebelColName & " : " & siebelCol'
End If
Next i
getRevColumns = bag
End Function
Try removing the parens around itm in the add:
bag.Add itm
or
bag.Add itm, key
It's been a while since I've had to work with VBA/VB6, but I believe including the parens causes itm to be passed by value instead of by reference. I could be wrong.
the bag is an object. Rule #1 for objects use Set
Set getRevColumns = bag
You need to say
set getRevColumns = bag
also I guess you have a problem on the add. I don't know why this is but it works on
bag.add itm
I tried the whole thing in a simple manner here is my working code
Sub myroutine()
Dim bag As Collection
Dim itm As clsSimple
Set bag = getTheCollection()
Set itm = bag.Item(1)
MsgBox (itm.someObjectValue)
Set itm = bag.Item(2)
MsgBox (itm.someObjectValue)
End Sub
Function getTheCollection() As Collection
Dim bag As Collection
Dim itm As clsSimple
Set bag = New Collection
Set itm = New clsSimple
itm.someObjectValue = "value 1"
bag.Add itm
Set itm = New clsSimple
itm.someObjectValue = "value 2"
bag.Add itm
Set getTheCollection = bag
End Function
The class is really simple:
Public someObjectValue As String
Hope it helps
I had a similar problem with a collection.
I Dim'd it but hadn't set it with New or initialized it.
Basically i had
Dim collection1 As Collection
...
collection1.Add item 'no compile error just empty
I added the following before the add
Set collection1 = New Collection
Call collection1.init
then it worked like a charm...I had also moved the Dim statement from the Sub to the top of the Module to make it a class variable