Visio VBA - Adding Shape Data Properties - vba

i'm creating and testing a UserForm where user can add the shapes and add the predefined Shape Data Value to the Shape Data. The Shape Data name is "Element" as you can see the image below.
Dim vsoRound As Visio.Shape
Dim cell As Visio.cell
If (CheckBox1.Value) Then
Application.ActiveWindow.Page.Drop Application.Documents.Item("MS Icons.VSSX").Masters.ItemU("Round"), 5, 5
Set vsoRound = Application.ActiveWindow.Page.Shapes.ItemU("Round")
vsoRound.CellsU("ELement").FormulaU = """Fan"""
The value for this Shape Data is Fan. However it break at the last line of the code.
**Update:
I added the error message.

As workaround you can delete unused master Square in Visio Shape Test.vssm before drop master with same name from stencil MS Icons.vssx via your code!

Try add prefix.
vsoRound.CellsU("Prop.ELement").FormulaU = """Fan"""

Related

Catia V5 macro to get the coordinates of the points inside repetition(Points and Planes)

Using a Catia V5 macro I want to get the coordinates of the points inside Repetition(Points and Planes).1. This Repetition(Points and Planes).1 is inside a geometrical set (Shown in image).
I have used selection.search to select Repetition(Points and Planes).1. But I'm not able to get the coordinates of the points.
Dim objSel As Selection
objSel.Search "'Generative Shape Design'.'Repetition (Points and Planes)',sel"
I want to export the point coordinates to a txt file after selecting the geometrical set (pntRep shown in image).
The Repetition (Points and Planes) object is threated as a HybridBody, the same as a GeometricalSet.
So, to get the instance of Repetition all you have to do is threat him as a HybridBody, you don't need to use Selection.Search method to get it you could do as follow:
Dim HybridBodypntRep as HybridBody
dim HybridBodyInternal as HybridBody
set HybridBodypntRep = objSel.item(1).value
for i = 1 to HybridBodypntRep.HybridBodies.Count
set HybridBodyInternal = HybridBodypntRep.HybridBodies.Item(i)
for j = 1 to HybridBodyInternal.HybridShapes.Count
'Here you will have access to all points and planes inside the Repetition
dim Element as HybridShape
set Element = HybridBodyInternal.HybridShapes.Item(j)
'Element is probably your point, just check it
next
The Element object is the one that is probably your Point.
Note that this code will loop over all the internal Geometrical Sets inside the selected one, in the first level and look for all elements inside it.

VBA macros for CATIA works on one computer, and doesn't work on another

I have a CATIA macro in VBA, that draws points by coordinates (from arrays).
It works on my computer (Catia V5-R2014 and on my neigbours - two versions V5-R2014 and R21).
But it doesn't work for colleges in a different city (they have version R21).
Basically, my macro reads input data from file, calculates coordinates, writes them in out-file, and then draws these points.
All steps except the last one work on either computer/version.
But at the last step "their" Catia just doesn't plot anything, w/o any errors.
So the Subruotine for the last step is:
Sub PlotGeometry()
' Nmlp - number of points
Dim i As Integer
Dim oPartDocument As Document
Dim ohSPointCoord() As HybridShapePointCoord
Dim ohSPoints As HybridShapePointCoord
Dim bodies1 As Bodies
Dim body1 As Body
ReDim ohSPointCoord(0 To Nmlp)
Set oPartDocument = CATIA.Documents.Add("Part")
Set oPart = oPartDocument.Part
Set oPartBody = oPart.MainBody
Set oPlaneYZ = oPart.CreateReferenceFromGeometry(oPart.OriginElements.PlaneYZ)
' -- Draw Points
Dim ohSFactory As HybridShapeFactory
Set ohSFactory = oPart.HybridShapeFactory
For i = 0 To Nmlp
Set ohSPointCoord(i) = ohSFactory.AddNewPointCoord(XM(i), YM(i), ZM(i))
oPartBody.InsertHybridShape ohSPointCoord(i)
Next i
oPart.Update
End Sub
What can it be?
Perhaps at your site you have Hybrid Design enabled, and at the other site they do not.
With Hybrid Design enabled, you would be able to add points to a Body. Not so if it is not enabled and you would get no error from your code.
The setting is under Tools->Options->Infrastructure->Part Infrastructure->Part Document Tab->Enable hybrid design inside part bodies and bodies.
For unexplained reasons, hybrid design being enabled is the default. However I do not recommend using it.
If you just want to make your code work in both places then use a Geometrical Set to aggregate your points instead of the main body.
Dim pointsBody as HybridBody
Set pointsBody = oPart.HybridBodies.Add
pointsBody.Name = "Points_Body"
...
For i = 0 To Nmlp
Set ohSPointCoord(i) = ohSFactory.AddNewPointCoord(XM(i), YM(i), ZM(i))
pointsBody.AppendHybridShape ohSPointCoord(i)
Next i
Just a random guess:
Go to VBE>Tools>References
and compare the values from both computers. They should be identical.
Compare these checkboxes:
If they are different, make sure to make them identical to the PC that works.

Is it possible to move a part with repect to constraints in Product using Catia vba?

I have to move a probe like sphere between two parts such that the probe is in contact with both the parts. And I have to find the point of contact of the parts, measure their distance and make a fillet on the parts based on this distance. I have achieved in moving the sphere between the parts but the sphere is moving through the parts. So trying to move with respect to constraints
I am trying to automate the manipulate tool in Catia Product.
Is there any command or method exist to move a part with respect to contraints in Catia using vba ?
Or
Is there any way to find the clash between two parts using vba ?
Looking Forward for a solution.
Thank you!!!
Here is a link where you can find a solution for clash.
OK, I got the idea, you want to see the code here :-)
To compute clash in a CATScript:
Sub CATMain()
' get root product of document
Dim RootProd As Product
Set RootProd = CATIA.ActiveDocument.Product
' retrieve selection object of active document
Dim objSelection As Selection
Set objSelection = CATIA.ActiveDocument.Selection
' get two selected objects
If (objSelection.Count2 <> 2) Then
MsgBox "Before running the script you must select two products to compute clash for", vbOKOnly, "No products selected"
Exit Sub
End If
Dim FirstProd As Product
Dim SecondProd As Product
Set FirstProd = objSelection.Item2(1).Value
Set SecondProd = objSelection.Item2(2).Value
' create groups for clash computation
Dim objGroups As Groups
Set objGroups = RootProd.GetTechnologicalObject("Groups")
Dim grpFirst As Group
Dim grpSecond As Group
Set grpFirst = objGroups.Add()
Set grpSecond = objGroups.Add()
' add selected products to groups
grpFirst.AddExplicit FirstProd
grpSecond.AddExplicit SecondProd
' get access to Clashes collection
Dim objClashes As Clashes
Set objClashes = RootProd.GetTechnologicalObject("Clashes")
' create new clash
Dim newClash As Clash
Set newClash = objClashes.Add()
' set new clash to be computed between two groups (two selected products)
newClash.FirstGroup = grpFirst
newClash.SecondGroup = grpSecond
newClash.ComputationType = catClashComputationTypeBetweenTwo
' compute clash
newClash.Compute
End Sub

Powerpoint VBA Runtime Error 438 (easy)

I am all new to powerpoint vba. All i want do is to write a little piece of code wich allows me to change the layout of my slide depending on a selection made by clicking a button.
The Problem with my code is that i get the runtimeerror 438.
Here is what i have:
Private Sub CommandButton1_Click() 'Klick Button 1'
ActivePresentation.Slides(10).Delete
ActivePresentation.Slides(9).Delete
ActivePresentation.Slides(8).Delete
Dim x As Integer
For x = 1 To 100
With ActivePresentation.Slides(x)
If .CustomLayout = .CustomLayout(8) Then
Set .CustomLayout = .CustomLayout(12)
End If
End With
Next x
End Sub
EDIT: Error Description is: "object does not support this property or method"
I'd really appreciate any kind of help and constructive input.
EDIT II: I understand now that .CustomLayout returns a custom layout. But how can i set/change the Layout of a certrain slide? How do i need to adress it?
Thank you very much
EDIT III: I still have no solution and i am really frustrated right now. You guys are my last chance for help I guess. So here again my code right now:
Dim x As Integer
For x = 7 To 100
If ActivePresentation.Slides(x).CustomLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(8) Then ActivePresentation.Slides(x).CustomLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(12)
End If
Next x
I still get the runtime error descriped above. How can i get rid of it and make my code work?
Thank you very much!
CustomLayout is an object tha define a custom layout, in the interface they are:
In vba they can be accessed using the ActivePresentation.Designs.SlideMaster object.
Every Slide object can have, obviously, only 1 CustomLayout applied, and you can access it using the property CustomLayout.
So, if you want to change the slide 1 CustomLayout using the CustomLayout n. 3 you have to do:
ActivePresentation.Slides(1).CustomLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(3)
See : MSDN
Regarding your code, you MUST use Names in your If block comaprison, so:
If ActivePresentation.Slides(x).CustomLayout.Name = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(3).Name Then
ActivePresentation.Slides(x).CustomLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(7)
End If

How to update CATIA part in vba?

I am trying to edit the part dimension in CATIA by changing the dimension values in the design table in the excel file. Everytime when i change the values i should manually update the part model. I want to update it automatically through VBA code and save it.
I tried
Sub CATMain()
CATIA.DisplayFileAlerts = False
Dim part As PartDocument
Set part = CATIA.ActiveDocument
part.Update
part.SaveAs "D:\E\CSE\.....\Part2.CATPart"
End Sub
and it is not working.
How can we update and save it??
You called ".Update" on the Document object, not the Part-object!
Answer is:
Dim part As PartDocument
Set partDoc = CATIA.ActiveDocument
partDoc.Part.Update
Your Code is correct and it should be working. Do you get any errors?
If you simply want an automatic update try to change your settings ...
Goto Tools->Options Then in the options dialog, goto Infrastructure Tree Node, and expand that and goto Part Infrastructure. Now on the right pane in the General Tab, Make sure you select Automatic for the Updates.
If this doesn't work you could try to the Part.UpdateObject objectToUpdate method to update the individual feature(s) that need to be updated.