How to change position of TXT and dimensions in FTA by VBA - vba

I have small problem, does anyone know how to change position of existing dimensions and Notes in Part/Product using short macro.
I will shortly describe what I want to do and what kind of problem I have.
I have simple model (let say rectangle)
Inside this model I have dimensions and annotations created in FTA.
Next step is to drastically change position of this model (base model in point 0,0,0 and I want tochange it position to 150,10000,80 + rotation)
during this change some dimensions and annotations (Theirs position in 3D) are not fully following after geometry.
Because of that I would like to have simple macro to create new position of my dimensions and annotations after part update.
I have performed some simple tests code bellow
What I have noticed, when I set new position of the text:
Theoretically text change position but in 3D it stays in old position.
When edit my text by double click on it and then click OK my text translates to new position which was set in macro earlier. The same situation is when I would like to change frame of the text or content (I had AAA and I would like to have BBB), it's changes only when I open Text editor.
Set part1 = CATIA.ActiveDocument
Set Selection = part1.Selection
Set VisPropertySet = Selection.VisProperties
Selection.Search ("name='Text.1',all")
' get selected annotation here
Dim anAnnotation As Annotation
Set anAnnotation = CATIA.ActiveDocument.Selection.Item(1).Value
' get annotation on the DrawingText interface
Dim txtAnnotation As DrawingText
Set txtAnnotation = anAnnotation.Text.Get2dAnnot()
' get TPS view that contains annotation on the DrawingView interface
Dim vwTPSView As DrawingView
Set vwTPSView = txtAnnotation.Parent.Parent
' get coordinates on a view
Dim dX ' as Double
txtAnnotation.X = 0
txtAnnotation.Y = 30
txtAnnotation.FrameType = catEllipse
part1.Update
End Sub

Generally using Part.Update refreshes the annotation's position and text but you can also use:
Dim anAnnotation As Annotation
'Code here
anAnnotation.ModifyVisu 'This should work for both Texts and Dimensions
But if the above method does not work, you can try reseting the text on the annotation (It will work only for texts, and not for dimensions)
Dim vwTPSView As DrawingView
'Code here
vwTPSView.Text = vwTPSView.Text
Be carefull with this last methos though. If your text has any parameters or variables inside it, replacing the text will clear it.

Related

Is there an alternative to View.GetOutline() which gives a better outline?

Outline returned by View.GetOutline() method does not quite correspond to the visible drawing - it returns a bit more than the selection outline shown by SolidWorks GUI.
The screenshot below shows the selection outline (light blue dotted rectangle) and diagonal of the outline returned by View.GetOutline() (red line):
Is there a way to get bounding box that corresponds to the actually visible drawing?
Note: Original title of this question was "Is there an alternative to View.GetOutline() which does NOT include Temporary Axes?", however I discovered that View.GetOutline() actually does not include Temporary Axes. The problem was in the View.Position property which defines center bounding box that includes Temporary Axes.
Artem's answer was quite useful so I decided to change the question to correspond to the answer and post a new question for the actual problem.
You can get the bounding box from underlying model via IPartDoc::GetBox/IAssemblyDoc::GetBox API and transform this to a view space via IView::ModelToViewTransform as shown in this example.
You will only need the following portion of code form the DrawBBoxDiagonal function if you do not want to draw the diagonal. The values of vStartPt and vEndPt are the end points of bounding box.
Dim vBox As Variant
Dim swViewTransform As SldWorks.MathTransform
Dim swMathPt As SldWorks.MathPoint
Dim vStartPt As Variant
Dim vEndPt As Variant
vBox = GetViewRefModelBBox(view)
Set swViewTransform = GetViewToSheetTransform(draw, view)
Dim swMathUtils As SldWorks.MathUtility
Set swMathUtils = swApp.GetMathUtility
Dim dPt(2) As Double
dPt(0) = vBox(0): dPt(1) = vBox(1): dPt(2) = vBox(2)
Set swMathPt = swMathUtils.CreatePoint(dPt)
Set swMathPt = swMathPt.MultiplyTransform(swViewTransform)
vStartPt = swMathPt.ArrayData
dPt(0) = vBox(3): dPt(1) = vBox(4): dPt(2) = vBox(5)
Set swMathPt = swMathUtils.CreatePoint(dPt)
Set swMathPt = swMathPt.MultiplyTransform(swViewTransform)
vEndPt = swMathPt.ArrayData
I would also recommend to get precise bounding box via IBody2::GetExtremePoint as shown here

itextsharp underlined text in cell falls outside cell

I have been able to create a PDF using iTextSharp in my VB .net code that looks almost exactly as I want it to. However, I am using a table with one column and multiple rows to display long text strings put together by using chunks and phrases. Some of the chunks contain text that is underlined. When there is underlined text in a phrase, the entire cell needs to be highlighted gray, and I am using the BackgroundColor property of PdfPCell for this.
The problem I am having is that the underline line falls outside of the cell boundaries (outside of the highlighting). I have tried many things to fix this such as setting a fixed cell height and then setting cell.VerticalAlignment to Element.ALIGN_TOP; using SetLeading with various values including (0, 0) which only made the problem worse; setting cell.Ascender to True; and changing padding values. I may have tried other things too, but for some reason, no matter what I try, the line for the underline text falls outside the highlighting. And, the highlighting goes right up to the bottom of the text in the cell above (which is why I tried playing with the SetLeading values.)
The image shows page 2 of my resulting PDF.
PDF with table
Below is and example of the sections of code that are implementing this - "outString1" and "outString2" are the output text strings that get appended to a single line. There is one Boolean value to determine if a chunk of text needs to be underlined, and one to determine if cell highlighting is needed - there are some cases where the cell might be highlighted but the text is not underlined. Any suggestions for how I can fix this?
Dim pdfTable As PdfPTable = New PdfPTable(1)
pdfTable.WidthPercentage = 100
'the next section is within a loop to create and load each cell
Dim P As New Phrase()
'Slisted is a Boolean value to determine need for underlining
If Slisted Then
P.Add(New Chunk(outString1, myULfont))
Else
P.Add(New Chunk(outString1, myfont))
End If
P.Add(New Chunk(outString2, myfont))
Dim cell As PdfPCell = New PdfPCell(P)
cell.Border = 0
cell.Padding = 0
'hilite is a Boolean value to determine whether
If hilite Then
cell.BackgroundColor = BaseColor.LIGHT_GRAY
End If
pdfTable.AddCell(cell)
'out of loop, load table into document
pdfDoc.Add(pdfTable)
An underline, by default, is a certain offset away from the text. Unfortunately, since you've killed off the padding on the table that offset is conflicting with the cell's layout. One option is that you should just change the padding as people have suggested. Another option, however, is to manually set the underline's offset of the Chunk on your own. Below is a sample of that:
Dim T As New PdfPTable(1)
For I = 1 To 10
''//Your chunk
Dim Ch As New Chunk("Hello", DocFont)
''//Wrap the chunk in a phrase
Dim p As New Phrase(Ch)
''//Wrap the phrase in a cell
Dim cell As PdfPCell = New PdfPCell(p)
''//Optional borders and padding
cell.Border = 0
cell.Padding = 0
''//This is just an example to do every other cell
If I Mod 2 = 0 Then
cell.BackgroundColor = BaseColor.LIGHT_GRAY
''//Set the thickness and offset from the text
Ch.SetUnderline(0.1, 0)
End If
T.AddCell(cell)
Next

Word VSTO - Change the absolute positions' type?

I use the following VB.NET (VSTO) code to add a shape in MS-Word,
Dim app As Word.Application = Globals.ThisAddIn.Application
Dim doc As Word.Document = app.ActiveDocument
Dim left As Single = CSng(Convert.ToDouble(app.Selection.Information(Word.WdInformation.wdHorizontalPositionRelativeToPage)))
Dim top As Single = CSng(Convert.ToDouble(app.Selection.Information(Word.WdInformation.wdVerticalPositionRelativeToPage)))
Dim shape As Word.Shape = doc.Shapes.AddShape(1, left, top, 225.1F, 224.5F)
shape.Fill.BackColor.RGB = ColorTranslator.ToOle(Color.Transparent)
shape.Fill.Visible = Microsoft.Office.Core.MsoTriState.msoFalse
shape.Fill.Transparency = 0.0F
shape.Line.Transparency = 0.0F
shape.Line.Visible = Microsoft.Office.Core.MsoTriState.msoFalse
What this code does is, it adds a rectangle shape at cursor point and makes it transparent (both background and line).
Now I like to change the absolute positions' type. To explain further, when you select the rectangle shape, then if you select the Ribbon tab Format > Position > More Layout Options... as shown in the image below,
It will open the following dialog,
In the above dialog I like to change Column and Paragraph marked by the red rectangles into the type Margin. How to do this by code?
Word provides a Macro recorder. You may use it to get the code generated for you in the background. Thus, you will find what properties and methods exactly should be used to get the job done. See Record or run a macro for more information.
The solution to this was solved in the link below,
https://social.msdn.microsoft.com/Forums/vstudio/en-US/e69584d7-24fe-4396-9a82-26b7dae02584/word-vsto-change-the-absolute-positions-type?forum=vsto

Word VSTO (VB.NET) - Get the image location, size, etc,?

I am creating an add-in using VB.NET VSTO for MS-Word. In this program I need to retrieve the details such as Location (Left, Top) and Size (Height, Weight) of all the images on the document. I also want to retrieve the page number where the image is located. I use the following code,
Dim i As Integer
For i = 1 To Globals.ThisAddIn.Application.ActiveDocument.InlineShapes.Count
If Globals.ThisAddIn.Application.ActiveDocument.InlineShapes(i).Type = Word.WdInlineShapeType.wdInlineShapePicture Then
strHeight = Globals.ThisAddIn.Application.ActiveDocument.InlineShapes(i).ScaleHeight()
strWidth = Globals.ThisAddIn.Application.ActiveDocument.InlineShapes(i).ScaleWidth()
End If
Next i
However, this can only retrieve the Size (Height, Weight). How to get the Location (Left, Top) and page number of the image?
By its very nature, an InlineShape doesn't have a positionable top and left. It's, well, inline, which means it exists in the text layer of the document and the location floats depending on the text and/or other content before it. If the item is on page 2, and you insert 25 lines of text or another picture before InlineShape(i), said shape will float down to page 3 (or 4 or whatever.)
The height and width ARE accessible, simply by using .Height and .Width. ScaleHeight and ScaleWidth are properties that reflect the size of the object in the document relative to the original size of the object. You probably want to store the height and width as strings, though, since the property returns a single (numeric) value. For height and width:
Dim i As Integer
Dim shp as InlineShape
For i = 1 To Globals.ThisAddIn.Application.ActiveDocument.InlineShapes.Count
shp = Globals.ThisAddIn.Application.ActiveDocument.InlineShapes(i)
If shp.Type = Word.WdInlineShapeType.wdInlineShapePicture Then
strHeight = shp.Height.ToString()
strWidth = shp.Width.ToString()
End If
Next i
To get the page number, you have to reference the range of the InlineShape.
shp.Range.get_Information(Word.WdInformation.wdActiveEndPageNumber)
You can also get the top and left position of the image (although it might not do you any good, depending on why you want it). The get_Information method also has wdHorizontalPositionRelativeToPage and wdVerticalPositionRelativeToPage

How to export a PowerPoint shape as a good quality image file

I am trying to generate a few hundred basic graphics where the shape text and background color is based on a text string.
For this i have chosen to use PowerPoint, because i feel that the image styling is quite comprehensive for my function. The only program that i know how to do this is Adobe Photoshop, however i do not have that software.
I have got the export image function to work, however the image quality of the exported graphic is terrible
How could i get this done with a better image processor?
As can be seen, i have a powerpoint slide with a textbox to hold the stringvalues (Rectangle 5) and my "shape" which will be styled by the two RGB values in the text string.
the string value has the following format (pipe delimited)
Textbox 4.Name | Rounded Rectangle 7.Color | Rounded Rectangle 3.Color
Code used:
Private Sub btnProcess_Click()
Dim i As Integer
Dim StringsArray As Variant
Dim StringItems As Variant
' Call getlines to break all lines into separate records in stringsarray
StringsArray = getlines()
For i = 0 To UBound(StringsArray)
StringItems = Split(StringsArray(i), "|")
ActivePresentation.Slides("Slide1").Shapes("TextBox 4").TextFrame.TextRange.Text = StringItems(0)
ActivePresentation.Slides("Slide1").Shapes("Rounded Rectangle 7").Fill.ForeColor.RGB = StringItems(1)
ActivePresentation.Slides("Slide1").Shapes("Rounded Rectangle 3").Fill.ForeColor.RGB = StringItems(2)
ActivePresentation.Slides("Slide1").Shapes("Group 6").Export "C:\temp\file.emf", ppShapeFormatEMF, 150, 150, ppRelativeToSlide
Next i
End Sub
Function getlines() As Variant
Dim mylines As Variant
Dim mytext As String
mytext = ActivePresentation.Slides("Slide1").Shapes("Rectangle 5").TextFrame.TextRange.Text
mylines = Split(mytext, vbCr)
getlines = mylines
End Function
The vector graphics based PPT object as seen on the PowerPoint slide is not affected by the scale so at all zoom level the object will not appear distorted.
I could not find a way to output the object graphic as a true Metafile even the ppShapeFormatEMF format does not generate a vector based EMF, just a much larger image.
My best solution at the end, was to increase the base size of the PPT object and export the shape object using the ppShapeFormatPNG format thereby increasing the level of detail of the image.
Kinda Obvious.