I have a little macro that adds a new sheet to a drawing intended for creating a .dxf file for the laser cut-out of sheet-metal parts.
Sub CATMain()
Dim drawingDocument1 As DrawingDocument
Set drawingDocument1 = CATIA.ActiveDocument
Dim drawingSheets1 As DrawingSheets
Set drawingSheets1 = drawingDocument1.Sheets
Dim drawingSheet1 As DrawingSheet
Set drawingSheet1 = drawingSheets1.Add("Laser")
drawingSheet1.PaperSize = catPaperA0
drawingSheet1.[Scale] = 1#
drawingSheet1.Orientation = catPaperLandscape
CATIA.StartCommand "Unfolded View"
End Sub
I'd like to make an addition to this macro where it removes the border of the sheet format.
The manual method of doing this is shown in the following screenshot:
So I either need to find a VBA command to untick that box, or a command to use Sheet Style "NoBorderTest" (as seen in the screenshot).
I couldn't find a way to do either, any help would be appreciated.
I'm trying to accomplish exactly the same thing you are, I'm making drawings that contain a view scaled 1:1 that can be exported as a DXF for 3 axis machining. The format is very annoying, it makes it difficult to see the part profile if its size is similar to the paper dimensions. The drawing format "shadow" hides the geometry.
The work around that I came up with was to set the paper height and paper width to very small numbers, 0.0000001 seemed to work fine. The paper height and paper width properties are exposed APIs that you can work with:
Dim DXFRoot As DrawingRoot = DXFRepRef.GetItem("CATDrawingAccess")
Dim DXFSheets As DrawingSheets = DXFRoot.Sheets
Dim DXFSheet As DrawingSheet = DXFSheets.ActiveSheet
DXFSheet.PaperSize = CatPaperSize.catPaperUser
DXFSheet.Scale = 1
DXFSheet.SetPaperHeight(0.0000001)
DXFSheet.SetPaperWidth(0.0000001)
Related
I'm trying to insert a image in the first page header of a document, trough VBA.
There are multiple lines that can do this, but each has it problem, which I will list:
This is my favorite method, but it inserts the image not in the header of first page, but all the remaining ones, and it also doesn't allow me to set the position:
ActiveDocument.Sections(1).Headers(2).Shapes.AddPicture ("C:\1.jpg")
This returns an out of bounds error:
Set shpCanvas=ActiveDocument.Shapes.AddCanvas(Left:=0, Top:=0, Width:=180, Height:=50)
shpCanvas.CanvasItems.AddPicture FileName:="C:\1.jpg", LinkToFile:=False, SaveWithDocument:=True
Inserts the image directly, but its usually out of position, stays in the middle of the header where I'd rather have it on the left
ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.InlineShapes.AddPicture ("C:\1.jpg")
I'm just a beginner with VBA and word, I apologize for any grotesque ideas I might have
The first code example does work for me - I see the picture on the first page. But since you don't describe how your document is structured I may not be testing what you're using...
You should not try to use a canvas.
The difference between a Shape and an InlineShape is that Word handles the latter like a text character. If the third line is positioning the picture in the middle of the line that paragraph is probably formatted as "centered", rather than "left". Try changing the paragraph formatting.
To position the result when using a Shape an object variable is required to be able to handle what has been inserted. For example:
Dim shp As Word.Shape, ils As Word.InlineShape
Set shp = ActiveDocument.Sections(1).Headers(2).Shapes.AddPicture("C:\1.jpg")
shp.Top = 0
shp.Left = 0
An object is declared, then the picture being inserted is assigned to the object, in one step. Subsequently, the object variable can be used to address the picture.
Thanks for your help, more correctly it worked like this
Dim shp2 As Word.Shape
Dim shp3 As Word.InlineShape
Set shp3 = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.InlineShapes.AddPicture("C:\1.jpg")
Set shp2 = shp3.ConvertToShape
shp2.Top = 0
shp2.Left = 0
I have been searching for hours to try to find the answer to this question, but to no avail, so I'm hoping I can find the answer here.
I want to create a variable that refers to a pre-existing chart in PowerPoint so I can start automating its data. I want to refer to the chart by its name to make things very easy, but no matter what I do I cannot seem to give PPT a satisfactory Chart address.
I have tried almost every possible variation of the below, but without success:
Dim chrtPP As PowerPoint.Chart
Set chrtPP = ActivePresentation.Slides(1).Shapes.Charts("Chart3")
Could someone please tell me what I'm doing wrong?
Thanks!
You need to reference the shape by name (a 'Shape" in PowerPoint is actually any object that is on a slide and can be a simple shape, textbox, table, chart, group, media clip etc.). If you're on PowerPoint 2010 and higher, press Alt+F10 to open the selection pane to find the name of the selected chart object. It may be a standard chart object or a chart within a placeholder object. You can then reference the chart as follows:
Option Explicit
Sub ChartStuff()
Dim oShp As Shape
Dim oCht As Chart
Set oShp = ActivePresentation.Slides(1).Shapes("Chart 3")
If oShp.HasChart Then
Set oCht = oShp.Chart
End If
' Do stuff with your chart
If oCht.HasTitle Then Debug.Print oCht.ChartTitle.Text
' Clean up
Set oShp = Nothing
Set oCht = Nothing
End Sub
The key in programming PowerPoint is to ignore the object name in the Object Model for 'Shape' as it's very misleading!
In word I am looking for a keyboard short cut which allows me to move the paragraph in which my cursor currently is one paragraph/line up or down.
I am new to VBA etc, but found this
Sub OutlineMoveUp()
Selection.Range.Relocate wdRelocateUp
End Sub
This comes pretty close to what I am looking for, but seems to move the paragraph up according to its position in the outline structure (what can become rather confusing). I just want to move it one paragraph/line up or down (also irrespective of its formatting).
(RStudio offers this nice feature where you can simply move selected text lines without copy-pasting; I am looking for the equivalent in word).
many thx.
The Relocate method is designed to work in Outline mode see here. Try the Move method instead:
Selection.Range.Move Unit:=wdParagraph, Count:=-1
You may need to adjust Count to get the effect you desire --- if -1 doesn't work, try -2, etc.
This would probably be cleaner using cut/paste but try this:
Sub Test_NewP()
Dim doc As Word.Document
Dim CurR As Word.Range
Dim NewP As Word.Paragraph
Dim IndexP As Long
Set doc = ActiveDocument
If doc.ActiveWindow.View = wdOutlineView Then
MsgBox "This program doesn't work in outline view --- please switch to another view", vbOKOnly, "Error"
Exit Sub
End If
Set CurR = Selection.Paragraphs(1).Range
IndexP = doc.Range(0, CurR.End).Paragraphs.Count
Set NewP = doc.Paragraphs.Add(doc.Paragraphs(IndexP - 1).Range)
NewP.Range.Text = CurR.Text
CurR.Delete
Set NewP = Nothing
Set CurR = Nothing
Set doc = Nothing
End Sub
This likely won't reliably manage formatting, but you could add code to fix that.
Hope that helps.
In VBA, I'm trying to determine both the actual and the displayed size of a picture object on a worksheet. The displayed size can be different from the actual size due to scaling factors. So far, I've found the methods ScaleWidth and ScaleHeight, but I don't want to actually modify the picture object. Any ideas?
Unfortunatelly, it seems that the original measurements are not a public property of a picture. If you do not want to modify the original picture, you can create a duplicate of the said picture just for the scaling purpose.
This function accepts a shape (a picture in our case) and returns an array of Single type (width and height)
Private Function GetOriginalMeasurements(ByRef myShape As Excel.Shape)
Dim shpCopy As Excel.Shape
Dim measurements(1) As Single
Set shpCopy = myShape.Duplicate
' Reset original measurements
shpCopy.ScaleHeight 1, msoTrue
measurements(0) = shpCopy.width
measurements(1) = shpCopy.height
shpCopy.Delete
GetOriginalMeasurements = measurements
End Function
The Main() procedure is just a basic example of how to use it
Sub Main()
Dim myShape As Excel.Shape
Dim measurements() As Single
Dim width As Single
Dim height As Single
Set myShape = ActiveWorkbook.ActiveSheet.Shapes(1)
measurements = GetOriginalMeasurements(myShape)
width = measurements(0)
height = measurements(1)
Debug.Print width
Debug.Print height
End Sub
On my computer the duplicating and deleting of the shape is instant, but if you see some flickering, you may wish to turn off screen updating in that function.
I'm currently working with CATIA V5, and I want to use Macros (VBA), but I have some problems!
My question is: how to change the text of a cut view? (see the picture)
I tried to use : myView.Texts.item(1) to access to this "text" but I think that CATIA dont consider it as text...
I want to change this text without the intervention of the user ( without selections), can I do that?
IME, VBA scripting in drafting workbench is quite tricky at first..."MyTexts" is a collection of DrawingText objects.
MyDrawingText.Text = "MyNewTextValue"
The main trouble you will have is getting a handle on the specific text object that you want to modify. I found that the best way around this is to either scan the entire DrawingTexts collection in the DrawingView, and apply a unique name, DrawingText.Name="UniqueObjectName", or you create the drawing text from the script and you can more easily get a handle on the DrawingText object to put whatever value you want in there. Creating Unique Names makes your drawing more robust for future scripting
MyView.Texts.Count will also be useful to get the item number if the last created DrawingText object(s).
I'm happy to further explain if you need. Good luck!
Update/Edit:
As mentioned above, scripting with the drafting workbench is not always straight forward. It turns out that the callout texts do not exactly live in the DrawingTexts collection of a DrawingView, but they do live somewhere inside the drawing view...In this case, you're trying to edit the "ID" of the section view..That property isn't exposed through VBA either.
There is a hack/work-around which is to search the parent view for drawing texts and and then with some logic, which you'll need to come up with, scan the Selection for the texts you want to change. You should rename then while you're at it, this way it's easier to come back and find them again.
Here's an example starting with an Object Resolution of the Front View (the parent view of the section view)
Sub ChangeCallout()
'---- Begin resolution script for object : Front View
Dim drawingDocument1 As DrawingDocument
Set drawingDocument1 = CATIA.ActiveDocument
Dim drawingSheets1 As DrawingSheets
Set drawingSheets1 = drawingDocument1.Sheets
Dim drawingSheet1 As DrawingSheet
Set drawingSheet1 = drawingSheets1.Item("Sheet.1")
Dim drawingViews1 As DrawingViews
Set drawingViews1 = drawingSheet1.Views
Dim drawingView1 As DrawingView
Set drawingView1 = drawingViews1.Item("Front view") 'this is the parent view of the section view
'---- End resolution script
Dim sel As Selection
Set sel = drawingDocument1.Selection
Dim CalloutText As drawingText
sel.Clear 'clear the selection / good practice
sel.Add drawingView1 'add the parent view to the selection
sel.Search "Drafting.Text,sel" 'this will search the current selection for all drawing texts and add them to the selection
Dim thing As Variant
Dim i As Integer
For i = 1 To sel.Count
Set thing = sel.Item2(i)
Set CalloutText = thing.Value
'do some things/logic here to determine if this is a callout with some Ifs or Case statements
'CalloutText.Name = "Useful Unique Name"
'CalloutText.Text = "New Callout Label" 'whatever you want to rename it to
Next
End Sub
the text of the cut view is defined by the view name, to change it you should change the view name as describe bellow:
Sub CATMain()
Dim oDraw As DrawingDocument
Set oDraw = CATIA.ActiveDocument
Dim oSectionView As DrawingView
Set oSectionView = oDraw.Sheets.ActiveSheet.Views.ActiveView
oSectionView.SetViewName "Prefix ", "B", " Suffix"
End Sub
For scanning through the callout texts you can use below lines.
This would select the texts belonging to only callout and doesn't scan through all texts.
Sub CATMain()
Dim drawingDocument1 As Document
Set drawingDocument1 = CATIA.ActiveDocument
Dim selection1 As Selection
Set selection1 = drawingDocument1.Selection
selection1.Search "CATDrwSearch.DrwCallout,all"
selection1.Search "Drafting.Text,sel"
Dim i As Integer
For i = 1 To selection1.Count
MsgBox selection1.Item(i).Value.text
Next
End Sub