I cant figure out how to instantiate Power-copy using VBA macro. I have a CATPart1, that have Power-copy name "MyPC". And I want to instantiate this power-copy in current Part. Just for example, this Power-copy inputs are: "Plane", "Start_point" and "End_point". I found in "CAA V5 VB help" that there are InstanceFactory object, that have methods to instantiate power-copy and UDFs. But my code doesn't work.
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("gt")
Dim mplane As Plane
Dim StartPnt As point
Dim EndPnt As point
Set mplane = hybridBody1.HybridShapes.Item(1)
Set StartPnt = hybridBody1.HybridShapes.Item(2)
Set EndPnt = hybridBody1.HybridShapes.Item(3)
Dim InstFactory As InstanceFactory
Set InstFactory = part1.HybridShapeFactory
Dim instance
InstFactory.BeginInstanceFactory "MyPC", "D:\myFolder\Part1.CATPart"
InstFactory.BeginInstantiate
InstFactory.PutInputData "Plane", mplane
InstFactory.PutInputData "Start_point", StartPnt
InstFactory.PutInputData "End_point", EndPnt
Set instance = InstFactory.Instantiate
hybridBody1.AppendHybridShape instance
InstFactory.EndInstantiate
End Sub
An automation error occurs in line
InstFactory.BeginInstanceFactory "MyPC", "D:\myFolder\Part1.CATPart"
Does anybody help me to understand why it isn't work?
Thank you in advance)
There are two things that may be the cause of the error you are having:
1 -
Use
Dim InstFactory As InstanceFactory
Set InstFactory = part1.GetCustomerFactory("InstanceFactory")
instead of
Dim InstFactory As InstanceFactory
Set InstFactory = part1.HybridShapeFactory
2 - You need to activate the floating license KT1 in order to use the PowerCopy operation via API. To activate it, go to Catia menu -> Tools -> Options and then select the tab Shearable Products and active the license.
Related
I have this task where i need to find some type of hybridshapes and collect them in a listbox
i have done that part, but i need to create it in such a way that when user selects a item from the list box respective hybridshape or object should get selected in catia
here is the image
here is the code
Option Explicit
Dim ODoc As Document
Dim opartdoc As PartDocument
Dim oPart As Part
Dim ohybs As HybridBodies
Dim ohyb As HybridBody
Dim ohybshps As HybridShapes
Dim ohybshp As HybridShape
Dim i As Integer
Dim j As Integer
Private Sub UserForm_Initialize()
Set ODoc = CATIA.ActiveDocument
Set opartdoc = CATIA.ActiveDocument
Set oPart = opartdoc.Part
End Sub
Private Sub ListBtn_Click()
Set ohybs = oPart.HybridBodies
Set ohyb = ohybs.Item("Shapes")
Set ohybshps = ohyb.HybridShapes
For i = 1 To ohybshps.Count
Set ohybshp = ohybshps.Item(i)
ShapeBox.AddItem ohybshp.Name
ShapeBox.Font.Bold = True
ShapeBox.Font.Size = 25
Next
End Sub
Private Sub SelectBtn_Click()
End Sub
i dont know much about listbox handling
how do i create link between items in listbox and objects in catia
thanks
Hi you could add this to your code and try it. Beware your solution is pretty fragile one. You should consider more robust checks for objects validation
The trick lies in ShapeBox.Value in Shapebox click event. The rest is just catia stuff. But this solution is not foolproof because if you have more shapes with same names it might not select the right one. I would prefer creating a collection where you store real object from sets and the passing these objects to selection
Private Sub ShapeBox_Click()
Call opartdoc.Selection.Clear
Call opartdoc.Selection.Add(opartdoc.Part.FindObjectByName(ShapeBox.Value))
End Sub
I'm currently working on developing a macro that will input various forms into an access database.
Due to the nature of the beast of this program, I've had to split my main program into two sub programs and call them, but I need to use getobject to call a file path twice now.
I use getobject to open a file, and then use myrec.fields(~column name~) = xlsht.cells(1, "a") to populate various column values. I'm unsure if there are other "efficient" ways to accomplish this.
I was wondering if it is possible to use a variable in place of the filepath with the GetObject command, instead of needing to manually replace the file path in the code.
I've tested a fair amount of different code, including the path, class functionality but I don't think I understand VBA enough to truly make the best use of that.
I can make it work using this
Dim XL As Variant
Dim XLApp As Variant
Dim XLsht As Variant
Dim XLwrkbk As Variant
Set XL = CreateObject("Excel.Application")
Set XLwrkbk = GetObject(~file path~)
Set XLsht = XLwrkbk.Worksheets(1)
Set MyRec = CurrentDb.OpenRecordset("database name")
Ideally I would like it to be
Dim filename As String
Dim XL As Variant
Dim XLApp As Variant
Dim XLsht As Variant
Dim XLwrkbk As Variant
filename = " ~insert file path~ "
Set XL = CreateObject("Excel.Application")
Set XLwrkbk = GetObject(filename)
Set XLsht = XLwrkbk.Worksheets(1)
Set MyRec = CurrentDb.OpenRecordset("database name")
I receive a run time error
Run-time error '5':
Invalid procedure call or argument.
Try something like this:
Dim XL As New Excel.Application, Filename As String
Filename = "~ your file ~"
XL.Workbooks.Open (Filename)
myrec.fields(~column name~) = XL.Worksheets(1).Range("A1").value
I have a Catia part where I have a few sketches on different planes. I need to be able to convert these sketches into 3D points which I copy to a new part document.
I have tried to use the Search and Selection commands in VB script in order to use a macro to pick up all the 2D points in my sketch and convert them to 3D points but to no avail.
Sub CATMain()
Set oSel = CATIA.ActiveDocument.Selection
strArray(0)=”Part”
Msgbox “Please select parts to join.”
sStatus = oSel.SelectElement3(strArray, “Select parts”, False, CATMultiSelTriggWhenUserValidatesSelection, false)
iCount = oSel.Count
For i= 1 to iCount
Set myObject2 = oSel.Item(i).value
oSel.Search “Name=Point,sel”
ReDim copies(iCount)
For k=1 to iCount
Set copies(k)=oSel.Item(k).Value
oSel.Add copies(k)
oSel.Copy
Next ‘k
Next ‘i
Set part2 = CATIA.Documents.Add(“CATPart”)
part2.Product.PartNumber = “My New Part”
Dim GSet1 As HybridBody
Set GSet1 = part2.Part.HybridBodies.Item(1)
GSet1.Name = “My Geometry”
Set partDocument2= CATIA.ActiveDocument
Dim ActSel As Selection
Set ActSel=partDocument2.Selection
ActSel.Add GSet1
ActSel.PasteSpecial(“CATPrtResultWithOutLink” )
ActSel.Clear
End Sub
You have to disassemble the sketch to get at the points as something you can copy
The disassemble command is exposed in VB via the HybridShapeFactory.AddNewDatums method.
Option Explicit
Sub CATMain()
Dim oPart As part
Set oPart = CATIA.ActiveDocument.part
Dim oHSF As HybridShapeFactory
Set oHSF = oPart.HybridShapeFactory
Dim sx As Sketch
Set sx = oPart.HybridBodies.item("Geometrical Set.1").HybridSketches.item("Sketch.1")
'make a temporary body
Dim targetGS As HybridBody
Set targetGS = oPart.HybridBodies.add
targetGS.name = "TMP_BODY___DELETE_ME"
'create a datum curve from the sketch
Dim sxRef As Reference
Set sxRef = oPart.CreateReferenceFromObject(sx)
'make a zero-translate from the sketch
'This is required because AddNewDatums functions needs a HybridShape feature
Dim oZero As HybridShapeTranslate
Set oZero = oHSF.AddNewTranslate(sxRef, oHSF.AddNewDirectionByCoord(0#, 0#, 1#), 0#)
Call targetGS.AppendHybridShape(oZero)
Call oPart.UpdateObject(oZero)
'now do the disassembly
Dim oZeroRef As Reference
Set oZeroRef = oPart.CreateReferenceFromObject(oZero)
'un-datum the curve by making a zero translate
Dim domains() As Variant
domains = oHSF.AddNewDatums(oZeroRef)
Dim i As Integer
For i = 0 To UBound(domains)
Call targetGS.AppendHybridShape(domains(i))
Next
Call oPart.Update
'now we can copy the resulting points...
Dim oSel As Selection
Set oSel = CATIA.ActiveDocument.Selection
Call oSel.add(targetGS)
Call oSel.Search("'Generative Shape Design'.Point,sel")
'copy paste into the new part
MsgBox ("There are " & oSel.count & " points ready to copy")
< YOUR COPY PASTE CODE GOES HERE>
'delete the temporary geo set
Call oHSF.DeleteObjectForDatum(oPart.CreateReferenceFromObject(targetGS))
End Sub
I'm making a macro to automatically open a new drawing on the correct sheet format with filled in title block but I can't seem to figure out how to insert a pre-made .CATDrawing in the same way the following option in the page setup dialog box would:
see here: https://i.imgur.com/goClGIh.png
my current progress looks like this:
Sub CATMain()
Dim partDoc As PartDocument
Set partDoc = CATIA.ActiveDocument
Dim myParam As Parameter
Set myParam = partDoc.Part.parameters.Item("Description")
Dim documents1 As Documents
Set documents1 = CATIA.Documents
Dim MyDrawingDoc As DrawingDocument
Set MyDrawingDoc = documents1.Add("Drawing")
MyDrawingDoc.Standard = catISO
Dim MyDrawingSheets As DrawingSheets
Set MyDrawingSheets = MyDrawingDoc.Sheets
Dim MyDrawingSheet As DrawingSheet
Set MyDrawingSheet = MyDrawingSheets.Item("Sheet.1")
MyDrawingSheet.PaperSize = catPaperA3
MyDrawingSheet.[Scale] = 1#
MyDrawingSheet.Orientation = catPaperLandscape
**CATIA.StartCommand "Page Setup"**
Dim dView As DrawingViews
Set dView = MyDrawingSheet.Views
dView.Item("Background View").Activate
AddTextWithLinkedParameter dView, 20, 20, myParam
End Sub
Sub AddTextWithLinkedParameter(dViewToContainTheText As DrawingViews, xPos, yPos, Optional param As Parameter)
Dim dtext As DrawingText
Set dtext = dViewToContainTheText.ActiveView.Texts.Add("", xPos, yPos)
If Not param Is Nothing Then
dtext.InsertVariable 0, 0, param
End If
End Sub
This line here
CATIA.StartCommand "Page Setup"
should be replaced by a sequence of codes that does the same thing as clicking the options would as shown in the image above.
In my experience, I think you are better off writing a script to draw a title block rather than using a template. This way it's more flexible with regards to changing sheet size and orientation. You can also update the titleblock if sheet size and orientation changes. This is also how catia does titleblocks with the catscript. I would avoid StartCommand as it's not inline with the script execution.
That being said. If you want to use a "template", then the best way to do that is to setup your template catDrawing and then your script will open the template as read-only, do what you need, and then the user will save-as. Avoid StartCommand if you can.
Directly opening the .CATdrawing template has the same result.
One can do this by using the follwing code:
Dim documents1 As Documents
Set documents1 = CATIA.Documents
Dim mydrawingdoc As DrawingDocument
Set mydrawingdoc = documents1.Open("Path\Template.CATDrawing")
I want to change the time zone of all items in an Outlook 2010 calendar.
I am confused as to how one would work with the items of a collection as they are iterated in the loop. My main background is in Java, and as I understand loops there a single variable is used as a dummy variable that will take the value of all items in the collection, in turn. No special assignment is usually required for such FOR loops. Do you need to manually advance the variable in some way so as to keep the loop going?
Here is my code:
Public Sub TZFix()
Dim oAppointmentItem As Outlook.AppointmentItem
Dim tzs As Outlook.TimeZones
Dim tzCentral As Outlook.TimeZone
Dim oAppointments As Object
Dim oNS As Outlook.NameSpace
Set oNS = oOutlook.GetNamespace("MAPI")
Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)
Set tzs = Application.TimeZones
Set tzCentral = tzs("Central Standard Time")
For Each oAppointmentItem In oAppointments.Items
Set oAppointmentItem.StartTimeZone = tzCentral
Set oAppointmentItem.EndTimeZone = tzCentral
Next
End Sub
I believe that there is an issue with variable assignment within the loop, as I get an Error 91: Object Variable or With block variable not set error whenever I run it.
oOutlook is never assigned to and is therefore Nothing. You probably meant to set it to Application.
Also, setting local variables to Nothing in the end is redundant, remove that.
I also had this problem in my Script. For me the solution was setting the Macro-Security-Settings to the lowest and ran it again and it worked.
Maybe it's worth giving it a try!
I made the code working with few changes of your code. This is worked:
Public Sub TZ_change_to_Hawaii()
''''Changing the selected appointments' time zones to Hawaii
Dim tzs As Outlook.TimeZones
Dim tzCentral As Outlook.TimeZone
Set tzs = Application.TimeZones
Set tzCentral = tzs("Hawaiian Standard Time")
Dim objOL As Outlook.Application
Dim objSelection As Outlook.Selection
Dim objItem As Object
Set objOL = Outlook.Application
Set objSelection = objOL.ActiveExplorer.Selection
For Each objItem In objSelection
Set objItem.StartTimeZone = tzCentral
Set objItem.EndTimeZone = tzCentral
objItem.Save
Next
End Sub