I have .CATPART and I have manually done measurements. I want to create macro using CAT VBA and extract measurements from .CATPART and export it to excel.
Sorry, measures stored in the part or product are not exposed to in the API.
I never found a solution for this, but here is a code that allow to get the measurements from the user selection. you can't parse all measurements, but you can select them and parse the selection (this example works only on one measurement selected, you'll have to adapt if possible for many):
Set oSelection = CATIA.ActiveDocument.Selection
On Error Resume Next
sName = oSelection.Item2(1).Value.Name
On Error Goto 0
'selection should be named with "catiabase"
If InStr(LCase(sName), "catiabase") = 0 Then Exit Function
'Get Name
'PROBLEM: This search will empty the selection if no measurement is selected
oSelection.Search "Name=Length,sel"
'No Length, no measurement (here i need only 1 selection)
If oSelection.Count2 <> 1 Then Exit Function
'Get name of measurement
sName = oSelection.Item2(1).Value.Name 'not the same as previous!
You can also find here a method to get distance value between two parts, but it requires to know the parts you want to get distances from
Imagining the simplest situation:
Sub CATMain()
''Get ActiveDocument
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
''Get Part
Dim part1 As Part
Set part1 = partDocument1.Part
''Get list of parameter of part
Dim oParams As Parameters
Set oParams = part1.Parameters
Dim PatternFind As String
PatternFind = "Measure"
''MsgBox all values of the parameter that contains 'Measure'
For Each item In oParams
If InStr(item.Name, PatternFind) <> 0 Then
MsgBox (item.Name & " = " & item.value)
End If
Next
End Sub
[View of tree view]
Part1
Measures
MeasureEdge.1
Length=10mm
MeasureEdge.2
Length=100mm
You should do the necessary modifications to export to Excel.
Related
Goal: Find headings in a document by their font and font size and put them into a spreadsheet.
All headings in my doc are formatted as Ariel, size 16. I want to do a find of the Word doc, select the matching range of text to the end of the line, then assign it to a variable so I can put it in a spreadsheet. I can do an advanced find and search for the font/size successfully, but can't get it to select the range of text or assign it to a variable.
Tried modifying the below from http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldn't figure out how to select and assign the found text to a variable. If I can get it assigned to the variable then I can take care of the rest to get it into a spreadsheet.
'A basic Word macro coded by Greg Maxey
Sub FindFont
Dim strHeading as string
Dim oChr As Range
For Each oChr In ActiveDocument.Range.Characters
If oChr.Font.Name = "Ariel" And oChr.Font.Size = "16" Then
strHeading = .selected
Next
lbl_Exit:
Exit Sub
End Sub
To get the current code working, you just need to amend strHeading = .selected to something like strHeading = strHeading & oChr & vbNewLine. You'll also need to add an End If statement after that line and probably amend "Ariel" to "Arial".
I think a better way to do this would be to use Word's Find method. Depending on how you are going to be inserting the data into the spreadsheet, you may also prefer to put each header that you find in a collection instead of a string, although you could easily delimit the string and then split it before transferring the data into the spreadsheet.
Just to give you some more ideas, I've put some sample code below.
Sub Demo()
Dim Find As Find
Dim Result As Collection
Set Find = ActiveDocument.Range.Find
With Find
.Font.Name = "Arial"
.Font.Size = 16
End With
Set Result = Execute(Find)
If Result.Count = 0 Then
MsgBox "No match found"
Exit Sub
Else
TransferToExcel Result
End If
End Sub
Function Execute(Find As Find) As Collection
Set Execute = New Collection
Do While Find.Execute
Execute.Add Find.Parent.Text
Loop
End Function
Sub TransferToExcel(Data As Collection)
Dim i As Long
With CreateObject("Excel.Application")
With .Workbooks.Add
With .Sheets(1)
For i = 1 To Data.Count
.Cells(i, 1) = Data(i)
Next
End With
End With
.Visible = True
End With
End Sub
I wrote a macro that hides everything in several geometrical sets and the objects and geometrical sets in these first sets except one specific branch. I use this for saving a defined object of a huge and complicated specification tree as a STP file. (See attached below.)
(Small complication in this “Hide_and_Save” macro: adding bodies to my hide-selection works well but for my show-selection it didn’t work the same way. Why would this happen?)
I also wrote a macro that does iterative adjustments. For the iterations I use a Do While Loop and some parameters and measurements. To update these values, I have to update the part/object in every cycle. But there are some construction elements that issue errors until the loop is successfully completed. Therefore I deactivate all the geometrical sets that I don’t need for the iterations (inclusively all children) and later I reactivate them manually.
My goal is to improve automation, so I tried to use my “Hide_and_Save” macro for deactivation and reactivation. This didn’t work. When I record the process, each object is listed in a separate line and deactivated. Since there are more than 350 elements, I would like to avoid this.
How do I deactivate all subelements in a geometrical set (preferably with children) without addressing each element individually?
Attribute VB_Name = "Hide_and_Save"
'_______________________________________________________________________________________
'Title: Hide_and_Save
'Language: catvba
'_______________________________________________________________________________________
Sub CATMain()
'---------------------------------------------------------------------------------------
'Select active Part/Document
Dim myDocument As Document
Set myDocument = CATIA.ActiveDocument
Dim myPart As part
Set myPart = CATIA.ActiveDocument.part
'--------------------------------------------------------------
' Enter file path
Dim filepath As String
filepath = InputBox("Please select memory location", "Input filepath", "...")
If filepath = "" Then 'cancle, abort or empty input
MsgBox "No valid input / cancle !"
Exit Sub
End If
'--------------------------------------------------------------
' Hide/show Objects of Part/Products and save as STEP
' Update Model
CATIA.ActiveDocument.part.Update
' Deklaration of Selections and Properties
Dim selectionShow, selectionHide As Selection
Set selectionShow = myDocument.Selection
Set selectionHide = myDocument.Selection
Dim visPropertySetShow, visPropertySetHide As VisPropertySet
Set visPropertySetShow = selectionShow.VisProperties
Set visPropertySetHide = selectionHide.VisProperties
' Definition of the collection of geometric sets - HybridBodies
Dim hybridBodiesInPart, hybridBodiesInProcess As HybridBodies
Dim hybridBodiesInRS, hybridBodiesInHuelle As HybridBodies
' Definition of individual geometric sets - HybridBody
Dim hybridBodyInPart, hybridBodyProcess, hybridBodyInProcess As HybridBody
Dim hybridBodyRS, hybridBodyInRS As HybridBody
Dim hybridBodyHuelle, hybridBodyInHuelle As HybridBody
' Definition of the collection of 3D-objects - HybridShapes
Dim hybridShapesInHuelle As HybridShapes
' Definition of individual 3D-objects - HybridShape
Dim hybridShapeInHuelle, hybridShapeForm As HybridShape
' Hide objects
Set hybridBodiesInPart = myPart.HybridBodies
For Each hybridBodyInPart In hybridBodiesInPart
selectionHide.Add hybridBodyInPart
Next
Set hybridBodyProcess = hybridBodiesInPart.Item("Process")
Set hybridBodiesInProcess = hybridBodyProcess.HybridBodies
For Each hybridBodyInProcess In hybridBodiesInProcess
selectionHide.Add hybridBodyInProcess
Next
Set hybridBodyHuelle = hybridBodiesInProcess.Item("Huelle")
Set hybridBodiesInHuelle = hybridBodyHuelle.HybridBodies
For Each hybridBodyInHuelle In hybridBodiesInHuelle
selectionHide.Add hybridBodyInHuelle
Next
Set hybridShapesInHuelle = hybridBodyHuelle.HybridShapes
For Each hybridShapeInHuelle In hybridShapesInHuelle
selectionHide.Add hybridShapeInHuelle
Next
Set hybridShapeForm = hybridShapesInHuelle.Item("Form")
visPropertySetHide.SetShow 1 'hide
selectionHide.Clear
' Show objects
selectionShow.Add hybridBodyProcess
selectionShow.Add hybridBodyHuelle
selectionShow.Add hybridShapeForm
visPropertySetShow.SetShow 0 'show
selectionShow.Clear
' Data export as STP
stepAnswer = MsgBox("Should the displayed elements be saved as STEP?", 3 + 0, "Export: Form")
If stepAnswer = 6 Then
myDocument.ExportData filepath & "Form" & ".stp", "stp"
ElseIf stepAnswer = 3 Or stepAnswer = 2 Then 'cancle or abort
MsgBox "cancle !"
Exit Sub
End If
'---------------------------------------------------------------------------------------
MsgBox "Finished !" & vbCrLf & s
End Sub
(Usually I work with Generative Shape Design and use VBA for Macros.)
Each feature has an "Activity" parameter aggregated to it.
Dim oShape as HybridShape
For Each oShape In oGS.HybridShapes
Dim oActivity as Parameter
Set oActivity = oPart.Parameters.SubList(oShape,False).Item("Activity")
Call oActivity.ValuateFromString("False")
Next
Let me add that screwing with Activity of features is not a best practice. I NEVER do this myself. If you have access KBE (Specifically Knowledge Advisor Workbench) you can probably do what you want with Rules/Actions/Reactions, less coding and have a more robust model in the end.
Couldn't find the answer I was looking for.
I want to get the current page number String including its format.
For example: Some sections may have chapter identifier (1-1), some are in Roman style, etc..
My hope was to get the selection of the specific footer, then loop through the fields and get the Page field data (Output is the String I want).
So far as I can see, there is no option to loop through the footers of a given section, just get the general template and try working with it.
I'm aware of wdActiveEndAdjustedPageNumber from Selection.Range.Information, but it just gives me partial information.
Am I wrong? Is there a way to work with a specific footer I choose?
If not, can you guide me how to get the following data:
Closest chapter number value
Getting the page number value of a special format such as Roman, Alphabetical font (Meaning applying the page format on the wdActiveEndAdjustedPageNumber)
Thanks.
Edit for clarification:
In my word template, the Heading 1 style creates the following header: Chapter 1, followed by Chapter 2 and so on.
In page number format, there is an option to include the current Chapter value to the page number.
For example: Assuming the following setup
will result with these pages in the { PAGE } field: 1-1, 1-2, 1-3, ...
My goal is to somehow get this entire "value" for a specific page footer.
Here is a code snippet which won't work properly:
Sub getPageFieldInFooter()
' get current section number
Dim sectionNum As Integer
sectionNum = Selection.Range.Information(wdActiveEndSectionNumber)
'select first page footer, loop through its fields and find Page field
ActiveDocument.Sections(sectionNum).Footers(wdHeaderFooterPrimary).Range.Select
Dim f As Field
For Each f In Selection.Fields
If f.Type = wdFieldPage Then
' do something with the page data
MsgBox f.Data
End If
Next f
End Sub
The output of such a method is '1-1'
The reason it won't work is because it can retrieve the first page only (or the second using wdHeaderFooterEvenPages).
Same goes for Roman number format, or any other from that list.
For the following page number settings, I wish to get the "value" in a specific footer.
The code above will return the values for first or second page, and that's it.
Is there a way to access any footer in the document and perform my code example?
If not, how can I get the page number "value" for any footer I choose?
Hope this is clearer.
The following is working for me, although I'm not certain how reliable it is. Apparently, if I query the Footer (or Header) of the current selection in the document it will return the information for the Footer (or Header) of that page.
Things get very complicated as soon as you start working with multiple sections and Different First Page. I've done some testing for that in the code below, but I wouldn't swear it's "production code". However, it should give you a starting place.
Sub GetFormattedPageNumberFromSelection()
Dim sel As word.Selection
Dim sec As word.Section
Dim r As word.Range, rOriginal As word.Range
Dim fld As word.Field
Dim secCurrIndex As Long
Dim sNoPageNumber As String
Set sel = Selection
If Not sel.InRange(sel.Document.content) Then Exit Sub
Set sec = sel.Sections(1)
If Not sec.Footers(wdHeaderFooterFirstPage).exists Then
Set r = sec.Footers(wdHeaderFooterPrimary).Range
Else
Set r = sel.Range
Set rOriginal = r.Duplicate
secCurrIndex = sec.index
If secCurrIndex <> 1 Then
sel.GoToPrevious wdGoToPage
If sel.Sections(1).index = secCurrIndex Then
Set r = sec.Footers(wdHeaderFooterPrimary).Range
Else
Set r = sec.Footers(wdHeaderFooterFirstPage).Range
End If
rOriginal.Select 'return to original selection
ElseIf r.Information(wdActiveEndPageNumber) = 1 Then
Set r = sec.Footers(wdHeaderFooterFirstPage).Range
Else
Set r = sec.Footers(wdHeaderFooterPrimary).Range
End If
End If
For Each fld In r.Fields
sNoPageNumber = "No page number"
If fld.Type = wdFieldPage Then
Debug.Print fld.result
sNoPageNumber = ""
Exit For
End If
Next
If Len(sNoPageNumber) > 0 Then Debug.Print sNoPageNumber
End Sub
...and sometimes we don't see the simplest way.
Insert a Page field at the current selection, read the result, then delete it again:
Sub GetFormattedPageNumberFromSelection2()
Dim rng As word.Range
Dim fld As word.Field
Set rng = Selection.Range
Set fld = rng.Fields.Add(rng, wdFieldPage)
Debug.Print fld.result
fld.Delete
End Sub
What you haven't told us is how you're 'choosing' the page you want the reference for. Assuming it's based in whatever page is selected/displayed, you could use something like the following for a page header:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, Fld As Field
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
For Each Fld In Selection.HeaderFooter.Range.Fields
If Fld.Type = wdFieldPage Then
MsgBox Fld.Result
Exit For
End If
Next
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Application.ScreenUpdating = True
End Sub
Unfortunately, wdSeekCurrentPageFooter returns the next page's footer!, so you can't use that for the current footer. The following, however, should work wherever the PAGE # field is located:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, Fld As Field, bExit As Boolean: bExit = False
With ActiveWindow.ActivePane.Pages(Selection.Information(wdActiveEndAdjustedPageNumber))
For i = 1 To .Rectangles.Count
With .Rectangles(i).Range
For Each Fld In .Fields
If Fld.Type = wdFieldPage Then
MsgBox Fld.Result
bExit = True: Exit For
End If
Next
End With
If bExit = True Then Exit For
Next
End With
Application.ScreenUpdating = True
End Sub
OP Update:
Thanks for the code KazJaw, it prompted me to change the approach I am trying to tackle the problem with. This is my current code:
Sub Method3()
Dim intFieldCount As Integer
Dim i As Integer
Dim vSt1 As String
intFieldCount = ActiveDocument.Fields.Count
For i = 1 To intFieldCount
ActiveDocument.Fields(i).Select 'selects the first field in the doc
Selection.Expand
vSt1 = Selection.Fields(1).Code
'MsgBox vSt1
vSt1 = Split(vSt1, " ")(2) 'Find out what the (2) does
MsgBox vSt1
ActiveDocument.Bookmarks(vSt1).Select 'Selects the current crossreference in the ref list
Next i
End Sub
Ok the so the Code currently finds the first field in the document, reads its field code and then jumps to the location in the document to mimic a CTRL+Click.
However, It does this for all types of fields Bookmarks, endnotes, figures, tables etc. I only want to find Reference fields. I thought I could deduce this from the field code but it turns out figures and bookmarks use the same field code layout ie.
A Reference/Boookmark has a field code {REF_REF4123123214\h}
A Figure cross ref has the field code {REF_REF407133655\h}
Is there an effective way to get VBA to distinguish between the two? I was thinking as reference fields in the document are written as (Reference 1) I could find the field and then string compare the word on the left to see if it says "Reference".
I was thinking of using the MoveLeft Method to do this
Selection.MoveLeft
But I can't work out how to move left 1 word from the current selection and select that word instead to do the strcomp
Or perhaps I can check the field type? with...
If Selection.Type = wdFieldRef Then
Do Something
End If
But I am not sure which "Type" i should be looking for.
Any advice is appreciated
All REF fields "reference" bookmarks. Word sets bookmarks on all objects that get a reference for a REF field: figures, headings, etc. There's no way to distinguish from the content of the field what's at the other end. You need to "inspect" that target, which you can do without actually selecting it. For example, you could check whether the first six letters are "Figure".
The code you have is inefficient - there's no need to use the Selection object to get the field code. The following is more efficient:
Sub Method3()
Dim fld As Word.Field
Dim rng as Word.Range
Dim vSt1 As String
ForEach fld in ActiveDocument.Fields
vSt1 = fld.Code
'MsgBox vSt1
vSt1 = Split(vSt1, " ")(2) 'Find out what the (2) does
MsgBox vSt1
Set rng = ActiveDocument.Bookmarks(vSt1).Range
If Left(rng.Text, 6) <> "Figure" Then
rng.Select
End If
Next
End Sub
In a dropdown list I have a few items. Can I, when I select an item, get the position of that item in the list as a number?
If you are looking for the index of a Data Validation list, this is what I'd do:
Put the following code in the ThisWorkbook module:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ValidationIndex As Long
Dim rngTest As Excel.Range
'assumes the data validation is in a cell named "rngTest"
On Error Resume Next
Set rngTest = Sh.Range("rngTest")
If rngTest Is Nothing Then
Exit Sub
End If
On Error GoTo 0
If Not Intersect(ActiveCell, Sh.Range("rngTest")) Is Nothing Then
ValidationIndex = GetValidationIndex
MsgBox ValidationIndex
End If
End Sub
Put this function in the ThisWorkbook module also, or else in any regular module:
Function GetValidationIndex() As Long
'returns a 1-based index
Dim rngTest As Excel.Range
Dim varValidationString As Variant
Dim ErrNumber As Long
Dim i As Long
With ActiveCell.Validation
If .Type = xlValidateList Then '3
On Error Resume Next
Set rngTest = ActiveCell.Parent.Range(.Formula1)
'I do this goofy thing with ErrNumber to keep my indenting and flow pretty
ErrNumber = Err.Number
On Error GoTo 0
'if the Validation is defined as a range
If ErrNumber = 0 Then
GetValidationIndex = Application.WorksheetFunction.Match(ActiveCell.Value2, rngTest, 0)
Exit Function
'if the validation is defined by comma-separated values
Else
varValidationString = Split(.Formula1, ",")
For i = LBound(varValidationString) To UBound(varValidationString)
If varValidationString(i) = ActiveCell.Value2 Then
GetValidationIndex = i + 1
Exit Function
End If
Next i
End If
End If
End With
End Function
If you are using a list or combo box, ListIndex would seem to be what you are after.
VB Help for ListIndex property: Returns or sets the index number of the currently selected item in a list box or combo box. Read/write Long. Remarks. You cannot use this property with multiselect list boxes.
If nothing is selected, ListIndex's value is -1. If memory serves, it is a zero based index.
ListIndex cannot be set at design time so it is not listed in the properties window.
When entering your code, type the list box name then dot and the editor displays all the available properties. Scroll down the list, note any that look interesting, then look them up.
I think it is not necessary to use a function. You can get it by using only Match function, like in above Doug's answer.
Dim GetValidationIndex as Integer
Dim rngTest as Range
' Get the validation list
With ActiveCell.Validation
Set rngTest = ActiveCell.Parent.Range(.Formula1)
end with
GetValidationIndex = Application.WorksheetFunction.Match(ActiveCell.Value2, rngTest, 0)
The function GetValidationIndex is good.
However, for some regional settings the line varValidationString = Split(.Formula1, ",") is not valid, because the character used to separate the different values is ";"
I suggest use:
varValidationString = Split(.Formula1, Application.International(xlListSeparator))