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")
Related
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 have the below code to populate a combobox in a PDF document. As far as I can tell, the code is correct, according to the Acrobat Forms API Reference
However the code fails on the PopulateListOrComboBox call with this error:
Method 'PopulateListOrComboBox' of object 'IField' failed
Dim acroApp As Acrobat.acroApp
Set acroApp = New Acrobat.acroApp
Dim myForm As Acrobat.AcroAVDoc
Set myForm = New Acrobat.AcroAVDoc
Dim bOK As Boolean
bOK = myForm.Open("C:\Users\sholtzman\downloads\wordFormTest.pdf", "temp")
Dim theRealForm As AFORMAUTLib.AFormApp
Set theRealForm = New AFORMAUTLib.AFormApp
Dim pdField As AFORMAUTLib.Field
Set pdField = theRealForm.Fields.Add("triaCoverage", "combobox", 0, 10, 20, 100, 200)
Dim items(2) As String
items(0) = " "
items(1) = "Accept"
items(2) = "Reject"
pdField.PopulateListOrComboBox items
Furthermore, I tested this piece of code as well to try to fill it, but it also failed with the error:
Automation error Unspecified error
Dim myPDForm As Acrobat.AcroPDDoc
Set myPDForm = myForm.GetPDDoc
Dim jso As Object
Set jso = myPDForm.GetJSObject
jso.getField("triaCoverage").setItems(1) = " "
Lastly, when I save and close the document after adding the combobox, I can go in
and set list values manually. Any ideas how I can get this to work through code?
I did some more research and have found one answer just now by replacing the line:
jso.getField("triaCoverage").setItems(1) = " "
with
jso.getField("triaCoverage").setItems(items)
However, I prefer to use the PopulateListOrComboBox method if at all possible, so i will leave this unanswered for some time.
I have a .CATdrawing template that I use to create drawings for all my parts.
My current macro opens the template as desired.
What I would like to do is to change the working name of the document so that when the user clicks "save" the correct name is already in the dialog box and he only needs to browse to the correct location.
To clarify I'll add an image: https://i.imgur.com/eckBwRQ.png
In this image the text "Drawing2" needs to change to whatever I want it to be.
I do not want to save the .CATdrawing at this moment, the user must be allowed to continue work and save the document when it suits him.
I've been doing some searches on google and in the V5Automation.chm but I can't seem to find the code that does this.
My best guess was to try the following code:
'remember currently opened part.
Dim partDoc As PartDocument
Set partDoc = CATIA.ActiveDocument
Dim documents1 As Documents
Set documents1 = CATIA.Documents
'Open drawing
Dim mydrawingdoc As DrawingDocument
Set mydrawingdoc = documents1.Open("X:\Path\Template.CATDrawing")
'rename drawing
Set CATIA.ActiveDocument.Name = partDoc.Part.Parameters.Item("CUSTOM_NAME").ValueAsString
However I get an error saying
Invalid use of property
Any help would be greatly appreciated.
EDIT:
I've tried a few more things to do this but as of yet I've seen no success:
Left(mydrawingdoc.FullName, 10) = partDoc.Part.UserRefProperties.Item("CUSTOM_NAME").ValueAsString
this won't work either
EDIT2:
Ok so I found something that will give a completely different error:
mydrawingdoc.FullName = partDoc.Part.UserRefProperties.Item("CUSTOM_NAME").ValueAsString
Can't assign to read-only property
Does this mean it's impossible to do what I want?
Could a possible solution be to use NewFrom instead of Open like this:
Set mydrawingdoc = documents1.NewFrom("path\Template.CATDrawing")
And then immediately use the desired name while creating this drawingdocument?
It is not possible to change the name of a top-level document that has not been saved yet.
The best and only workaround, as far as I could find, is saving the document with the correct name in a temporary folder.
Example:
'remember currently opened part.
Dim partDoc As PartDocument
Set partDoc = CATIA.ActiveDocument
Dim documents1 As Documents
Set documents1 = CATIA.Documents
'Open drawing
Dim mydrawingdoc As DrawingDocument
Set mydrawingdoc = documents1.NewFrom("path\Template.CATDrawing")
'Save drawing with custom name extracted from 3D part
CATIA.ActiveDocument.SaveAs ("C:\CATIA_temp\" & partDoc.Product.UserRefProperties.Item("CUSTOM_NAME").ValueAsString & ".CATDrawing")
The code below reads and inserts the email from lotus notes to an excel sheet. However I would like to read a lotus notes database and copy its content and paste it as a rich text into a word document.
I assume this line of code needs to be modified.
Set nitem = .GetFirstItem("Body")
What would be the best way to go about this?
Public Sub Lotus_Notes_Current_Email4()
Dim NSession As Object 'NotesSession
Dim NUIWorkSpace As Object 'NotesUIWorkspace
Dim NUIdoc As Object 'NotesUIDocument
Dim nitem As Object 'NotesItem
Dim lines As Variant
Set NSession = CreateObject("Notes.NotesSession")
Set NUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")
Set NUIdoc = NUIWorkSpace.CurrentDocument
If Not NUIdoc Is Nothing Then
With NUIdoc.Document
Set nitem = .GetFirstItem("Body")
If Not nitem Is Nothing Then
lines = Split(nitem.Text, vbCrLf)
Sheets(1).Activate
Range("H8").Resize(UBound(lines) + 1, 1).Value = Application.WorksheetFunction.Transpose(lines)
End If
End With
Else
MsgBox "Lotus Notes is not displaying an email"
End If
Set NUIdoc = Nothing
Set NUIWorkSpace = Nothing
Set NSession = Nothing
End Sub
Your assumption is incorrect. Your entire script needs to be rewritten.
If you want to copy the contents of a view, then you need to start by opening a NotesView object. Your current code is opening a NotesDocument object. To get the NotesView, you might want to use the CurrentView property NotesUIWorkspace to get a NotesUIView object, and then use that objects View property.
Once you have the NotesView object, then I'm guessing you might want to want to use the columns property to get at the data, but there are other ways you could go about it. Pretty much no matter what you do, though, you're going to have to handle the formatting of the data on your own.
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.