I need to write a macro in Catia 5. My aim is to convert cgm files to png at the desired background color and at desired resolution. Manually I am doing it by Capture->image->options(setting resolution and background color)-> save as .
I need to do it by macro.
I can open the Capture window with CATIA.StartCommand "Capture"
but can not proceed furthermore. How can I proceed?
Thanks in advance.
HOW WE CAN USE COMMANDS WHICH ARE GIVEN IN OBJECT BROWSER IN MACRO? I AM DIRECTLY WRITING IT BUT DOES NOT WORK.
Unfortunately, the Capture command does not seem to be available through the macro API. I've successfully used this workaround, however:
Sub CaptureViewport(strFileName As String, Optional intWidth As Integer = 1024, Optional intHeight As Integer = 1024)
Dim objWindow As SpecsAndGeomWindow
Dim objViewer As Variant ' Viewer3D
Dim objCamera As Camera3D
Dim objViewpoint As Variant ' Viewpoint3D
Dim arrOldBackgroundColor(2) As Variant
Dim intOldRenderingMode As CatRenderingMode
Dim intOldLayout As CatSpecsAndGeomWindowLayout
Set objWindow = CATIA.ActiveWindow
Set objCamera = CATIA.ActiveDocument.Cameras.Item(1)
Set objViewer = objWindow.ActiveViewer
Set objViewpoint = objViewer.Viewpoint3D
objViewer.GetBackgroundColor arrOldBackgroundColor
intOldRenderingMode = objViewer.RenderingMode
intOldLayout = objWindow.Layout
' This might be extended to record the old window dimensions as well
objViewer.FullScreen = False
objViewer.PutBackgroundColor Array(1, 1, 1) ' White
objViewer.RenderingMode = catRenderShadingWithEdges
objWindow.Layout = catWindowGeomOnly
objWindow.Width = intWidth
objWindow.Height = intHeight
objViewpoint.PutSightDirection Array(-1, -1, -1) ' Isometric
objViewpoint.PutUpDirection Array(0, 0, 1)
objViewpoint.ProjectionMode = catProjectionCylindric ' Parallel projection
objViewer.Reframe
' Without this, the picture is not always sized correctly
CATIA.RefreshDisplay = True
objViewer.Update
objViewer.CaptureToFile catCaptureFormatBMP, strFileName
CATIA.RefreshDisplay = False
objViewer.PutBackgroundColor arrOldBackgroundColor
objViewer.RenderingMode = intOldRenderingMode
objWindow.Layout = intOldLayout
' This might be extended to restore the old window dimensions as well
End Sub
It works by temporarily changing the background color (among other things, such as spec. tree visibility, rendering mode and camera settings) and by using the CaptureToFile method. By changing the window size, you also change the dimensions of the captured image. Unfortunately, it cannot capture to PNG format (even though the interactive Capture tool can). This version instead captures to BMP. The JPEG mode compresses the picture beyond reason and is unusable. The compass will be visible in the pictures captured with this macro, if it is enabled in the interactive session.
Related
I am creating a powershell script that will auto generate publisher files for wristbands. On the Wristband is a QR code and a few other details to personally identify the wearer. I currently have a template file set up, a script that copies this, renames it, and edits some of the text on the page.
What I need it the script to change the placeholder image in the template to a QR code image, the data in the QR is only every going to be from a set amount of images (one of 1800), all have been generated and named to match up with the names used in Powershell.
Has anyone changed an image in MS Publisher using powershell before? Below is the code I currently have.
$CurrentMember = "M001S001"
$CurrectDocumet = "C:\Users\Rob\Documents\DistrictCamp2017\GeneratedFiles\" + $CurrentMember + ".pub"
copy-item "C:\Users\Rob\Documents\DistrictCamp2017\TemplateWristband.pub" "C:\Users\Rob\Documents\DistrictCamp2017\GeneratedFiles"
Rename-Item "C:\Users\Rob\Documents\DistrictCamp2017\GeneratedFiles\TemplateWristband.pub" "$CurrentMember.pub"
Add-Type -AssemblyName Microsoft.Office.Interop.Publisher
$Publisher = New-Object Microsoft.Office.Interop.Publisher.ApplicationClass
$OpenDoc = $Publisher.Open("C:\Users\Rob\Documents\DistrictCamp2017\GeneratedFiles\M001S001.pub")
###Replace Barcode and text
$pbReplaceScopeAll = 2
$OpenDoc.Find.Clear()
$OpenDoc.Find.FindText = "DEFAULT"
$OpenDoc.Find.ReplaceWithText = $CurrentMember
$OpenDoc.Find.ReplaceScope = "2" #$pbReplaceScopeAll
$OpenDoc.Find.Execute()
$OpenDoc.Save()
$OpenDoc.Close()
$Publisher.quit()
The image in the template document is currently a blank 145*145 pixel square, to be replaced by the appropriate QR code image, dependant on the value of $CurrentMember. I haven't yet written anything to try and change the image as I cannot find anything online, anything I search for seems to return results about Azure publisher server images.
Many thanks,
Rob
The easiest way is probably to get the shape by index, then add a new picture in its place, then remove the original shape:
Sub ReplaceFirstShapeWithImage()
Dim oPage As Page
Dim oShape As Shape
Dim newImage As Shape
Set oPage = Application.ActiveDocument.ActiveView.ActivePage
Set oShape = oPage.Shapes(1)
''https://msdn.microsoft.com/en-us/library/office/ff940072.aspx
Set newImage = oPage.Shapes.AddPicture("C:\Users\johanb\Pictures\X.png", msoFalse, msoTrue, oShape.Left, oShape.Top, oShape.Width, oShape.Height)
oShape.Delete
End Sub
This should help you find the right index
Sub GetIndexOfSelectedShape()
If Application.Selection.ShapeRange.Count = 0 Then
MsgBox "Please select a shape first"
Exit Sub
End If
Dim oShape As Shape
Dim oLoopShape As Shape
Dim i As Long
Set oShape = Application.Selection.ShapeRange(1)
For i = 1 To oShape.Parent.Shapes.Count
Set oLoopShape = oShape.Parent.Shapes(i)
If oLoopShape Is oShape Then
MsgBox oShape.Name & " has index " & i
End If
Next i
End Sub
Unfortunately I can't use PowerShell right now, but this VBA code should help you with the object model
I've created a form within Access which uses a cross-tab query as its data source.
The column headings for the query are 1, 2, 3, 4 and 5 representing week numbers.
The values display items such as 3/3 = 100.00% or 0/13 = 0.00% or 3/14 = 21.00%.
I've added conditional formatting to the text boxes on the form.
Expression Is Right([2],7)="100.00%" works and displays the figure in bold red when the percentage is 100.
Expression is Val(Right([2],7))=100 also works - converting the text value to a numeric value.
The problem I'm having is that I'm not always looking for 100% - it depends on the value within a table. What I'm trying to do is
Val(Right([2],7))=(SELECT ParamValue*100 FROM tbl_System WHERE Param='SampleSize') - this doesn't work.
Neither does:
Eval(Val(Right([2],7))=(SELECT ParamValue*100 FROM tbl_System WHERE Param='SampleSize'))
or
Val(Right([2],7))=EVAL(SELECT ParamValue*100 FROM tbl_System WHERE Param='SampleSize')
or
Val(Right([2],7))=DLookUp("ParamValue","tbl_System","Param= 'SampleSize'")*100
or
Val(Right([2],7))=Eval(DLookUp("ParamValue","tbl_System","Param= 'SampleSize'")*100)
The SQL for the cross-tab query is:
TRANSFORM NZ(Sum(Abs([Include])),0) & "/" & NZ(Count(*),0) & " = " &
FormatPercent(NZ(Round(Sum(Abs(Include))/Count(*),2),0),2)
SELECT tbl_TMP_PrimaryDataSelection.TeamMember
FROM tbl_TMP_PrimaryDataSelection
GROUP BY tbl_TMP_PrimaryDataSelection.TeamMember
PIVOT tbl_TMP_PrimaryDataSelection.WeekNum In (1,2,3,4,5)
I don't think you can use a function in there, be it system or user-defined.
But you can define the FormatCondition dynamically at runtime, like this:
Dim txtFld As TextBox
Dim objFrc As FormatCondition
Dim strExpr As String
Set txtFld = Me!myTextBox
' Remove existing FormatConditions
txtFld.FormatConditions.Delete
' The dynamic expression
strExpr = "Val(Right([2],7))=" & DLookUp("ParamValue","tbl_System","Param='SampleSize'")*100
' Assign a new FormatCondition to text box
Set objFrc = txtFld.FormatConditions.Add(acExpression, , strExpr)
' Set the format
objFrc.ForeColor = &HFF0000
This example simply removes and recreates all FormatConditions. If you have a fixed number of conditions, you can also use the FormatCondition.Modify method (see online help).
Edit:
The final code I have used executes on the Form_Load event and adds a format to each of the five weekly text boxes:
Private Sub Form_Load()
Dim aTxtBox(1 To 5) As TextBox
Dim x As Long
Dim oFrc As FormatCondition
Dim sExpr As String
With Me
Set aTxtBox(1) = .Wk1
Set aTxtBox(2) = .Wk2
Set aTxtBox(3) = .Wk3
Set aTxtBox(4) = .Wk4
Set aTxtBox(5) = .Wk5
For x = 1 To 5
aTxtBox(x).FormatConditions.Delete
sExpr = "Val(Right([" & x & "],7))>=" & DLookup("ParamValue", "tbl_System", "Param='SampleSize'") * 100
Set oFrc = aTxtBox(x).FormatConditions.Add(acExpression, , sExpr)
oFrc.ForeColor = RGB(255, 0, 0)
Next x
End With
End Sub
Edit 2
Yes, defining FormatConditions via VBA is especially useful when dealing with multiple controls in a loop. You can do this in Design View too and save the FormatConditions permanently, simply to avoid going through the FormatConditions dialogs one by one. Or if the customer later decides that he'd rather have a different color. :)
Note: You could use Set aTxtBox(x) = Me("Wk" & x) in the loop. But actually you don't need multiple TextBox variables, you can simply re-use it.
I use an automation script that tests a browser-based application. I'd like to save the visible text of each page I load as a text file. This needs to work for the current open browser window. I've come across some solutions that use InternetExplorer.Application but this won't work for me as it has to be the current open page.
Ideally, I'd like to achieve this using vbscript.
Any ideas how to do this?
You can attach to an already running IE instance like this:
Set app = CreateObject("Shell.Application")
For Each window In app.Windows()
If InStr(1, window.FullName, "iexplore", vbTextCompare) > 0 Then
Set ie = window
Exit For
End If
Next
Then save the document body text like this:
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("output.txt", 2, True)
f.Write ie.document.body.innerText
f.Close
If the page contains non-ASCII characters you may need to create the output file with Unicode encoding:
Set f = fso.OpenTextFile("output.txt", 2, True, -1)
or save it as UTF-8:
Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 2 'text
stream.Position = 0
stream.Charset = "utf-8"
stream.WriteText ie.document.body.innerText
stream.SaveToFile "output.txt", 2
stream.Close
Edit: Something like this may help getting rid of script code in the document body:
Set re = New RegExp
re.Pattern = "<script[\s\S]*?</script>"
re.IgnoreCase = True
re.Global = True
ie.document.body.innerHtml = re.Replace(ie.document.body.innerHtml, "")
WScript.Echo ie.document.body.innerText
Something that I would assume comes up a lot...
I'd like to know if there's a way to, in Access' Conditional Formatting, format all blank fields. In my case, all fields generally need to be entered, but not in all cases. So, instead of writing a bunch of conditional code to restrict the user to writing it in there, I just want some red backgrounds in my fields as a reminder "hey, there's nothing in here.. sure that's what you wanted?"It's on a tablet so Message Boxes would be annoying. So conditional formatting it is. I know you can have "Is Null([Field]) but that requires me to go through my 20+ forms on 30+ fields and ensure proper field names etc, then type the condition for them individually. Is there a way I can simply multi-select my fields, do a conditional format on Multiple, and use maybe "Is Equal To: NULL"?
I've tried "equal to: Null" and it doesn't work.. nor does "equal to: "" " (using the Access constants). Ideas why? Or how I can get around this? Also, it's only necessary for non-touched fields, so if the user starts to type then deletes back to blank, I don't care; it can stay unformatted or go back to red, so if there's a better way to do this I'm all eyes.
EDIT: I've started doing some VBA code which I will paste into all my forms:
Private Sub Form_Load()
Dim ctl As Control
Dim reqCol As Long
Dim focusCol As Long
Dim doneCol As Long
Dim format As FormatCondition
reqCol = RGB(246, 180, 180)
focusCol = RGB(252, 249, 238)
doneCol = RGB(255, 255, 255)
For Each ctl In Me.Controls
With ctl
Me.Controls(ctl.Name).FormatConditions.Delete 'Delete the existing conditions.
Me.Controls(ctl.Name).BackColor = doneCol 'Set the background color to the done color.
Select Case .ControlType
Case acTextBox
'Create the format objects.
format = Me.Controls(ctl.Name).FormatConditions.Add(acFieldValue, acEqual, "")
format = Me.Controls(ctl.Name).FormatConditions.Add(acFieldHasFocus)
'Format the filled in boxes (ie set back to red)
With Me.Controls(ctl.Name).FormatConditions(0)
.BackColor = reqCol
.Enabled = True
End With
'Format the current field color (ie set to beige)
With Me.Controls(ctl.Name).FormatConditions(1)
.BackColor = focusCol
.Enabled = True
End With
End Select
End With
Next ctl
End Sub
Problem is that FormatConditions.Add(acFieldValue, acEqual, "") doesn't work for the same reason... how do I get around this? Seeing as VBA and the built-in conditions are both flawed, seems like a bug. Or I'm missing something right in front of me..
In Access 2016 I was unable to find the default formatting option that is the solution provided by #SeanC. Instead I found that to get my Combo Box to format properly I had to use an Expression with ISNULL.
Set default format to the way to want zero length data to appear.
use
Field Value Is greater than ''
for the conditional formatting and set that format to how it should appear with text in the field.
You can select multiple fields with Shift+click in design view to select all the appropriate fields that this needs to be applied to
Solved. Put this in my forms (might look into making it a module; new to this, not sure how yet)
Private Sub Form_Load()
On Error Resume Next
Dim ctl As Control
Dim reqCol As Long
Dim focusCol As Long
Dim doneCol As Long
Dim format As FormatCondition
Dim expr As String
reqCol = RGB(246, 180, 180)
focusCol = RGB(252, 249, 238)
doneCol = RGB(255, 255, 255)
For Each ctl In Me.Controls
With ctl
'Delete the existing formatting
Me.Controls(ctl.Name).FormatConditions.Delete
Me.Controls(ctl.Name).BackColor = doneCol
Select Case .ControlType
Case acTextBox
expr = "IsNull(" & ctl.Name & ") = True"
'Create the format objects.
format = Me.Controls(ctl.Name).FormatConditions.Add(acFieldHasFocus)
format = Me.Controls(ctl.Name).FormatConditions.Add(acExpression, , expr)
'Format the filled in boxes (ie set back to focus color)
With Me.Controls(ctl.Name).FormatConditions(0)
.BackColor = focusCol
.Enabled = True
End With
'Format the current field color (ie set to required color)
With Me.Controls(ctl.Name).FormatConditions(1)
.BackColor = reqCol
.Enabled = True
End With
End Select
End With
Next ctl
End Sub
The trick was how to enter it into FormatConditions.Add(...). Works exactly how I'd like it to now.
I am a newbie to using activex controls in matlab. Am trying to control a word document. I need help translating between VBA syntax and Matlab, I think. How would one code the following in matlab?
Sub macro()
With CaptionLabels("Table")
.NumberStyle = wdCaptionNumberStyleArabic
.IncludeChapterNumber = True
.ChapterStyleLevel = 1
.Separator = wdSeparatorHyphen
End With
Selection.InsertCaption Label:="Table", TitleAutoText:="", Title:="", _
Position:=wdCaptionPositionAbove, ExcludeLabel:=0
End Sub
Thanks, I looked at the help and the source but I am still feeling dense. I want to be able to control caption numbering and caption text in an automated report. Am using Tables and figures. I just can't quite get my head around how to code the addition of the captions.
The following code gets me part way there. But I don't have control over numbering style, etc,. I have tried to figure out the activex structure but I can't make sense of it. In particular, In particular the first bit the VB subroutine above.
% Start an ActiveX session with Word
hdlActiveX = actxserver('Word.Application');
hdlActiveX.Visible = true;
hdlWordDoc = invoke(hdlActiveX.Documents, 'Add');
hdlActiveX.Selection.InsertCaption('Table',captiontext);
After some fiddling, I think I got it to work:
%# open Word
Word = actxserver('Word.Application');
Word.Visible = true;
%# create new document
doc = Word.Documents.Add;
%# set caption style for tables
t = Word.CaptionLabels.Item(2); %# 1:Figure, 2:Table, 3:Equation
t.NumberStyle = 0; %# wdCaptionNumberStyleArabic
t.IncludeChapterNumber = false;
t.ChapterStyleLevel = 1;
t.Separator = 0; %# wdSeparatorHyphen
%# insert table caption for current selection
Word.Selection.InsertCaption('Table', '', '', 0, false) %# wdCaptionPositionAbove
%# save document, then close
doc.SaveAs2( fullfile(pwd,'file.docx') )
doc.Close(false)
%# quit and cleanup
Word.Quit
Word.delete
Refer to the MSDN documentation to learn how to use this API. For example, the order of arguments of the InsertCaption function used above.
Note that I had to set IncludeChapterNumber to false, otherwise Word was printing "Error! No text of specified style in document" inside the caption text...
Finally, to find out the integer values of the wd* enums, I am using the ILDASM tool to disassemble the Office Interop assemblies (as this solution suggested). Simply dump the whole thing to text file, and search for the strings you are looking for.
Have a look at the help for actxserver and the source code for xlsread.m in the base MATLAB toolbox. If you're still stuck, then update your question with your progress.
EDIT:
You'll need to check the VBA help, but the first part ought to be possible via something like:
o = hdlWordDoc.CaptionLabels('Table');
o.NumberStyle = <some number corresponding to wdCaptionNumberStyleArabic>;
o.IncludeChapterNumber = true;
o.ChapterStyleLevel = 1;
o.Separator = <some number corresponding to wdSeparatorHyphen>;
In my experience, you have to get the values from the enumerations, such as wdCaptionNumberStyleArabic and wdSeparatorHyphen from a VBA script then hard-code them. You can try the following, but I don't think it works:
o.NumberStyle = 'wdCaptionNumberStyleArabic';
o.Separator = 'wdSeparatorHyphen';
Instead of hard-coding the text values into the code, you can use the enum constants. This will help when a different language of Word is installed.
A list of the Enums can be found here: https://learn.microsoft.com/en-us/office/vba/api/word(enumerations)
So instead of:
Word.Selection.InsertCaption('Table', '', '', 0, false) %# wdCaptionPositionAbove
you can use this:
NET.addAssembly('Microsoft.Office.Interop.Word')
Word.Selection.InsertCaption(...
Microsoft.Office.Interop.Word.WdCaptionLabelID.wdCaptionTable.GetHashCode,...
' My custom table caption text', '', ...
Microsoft.Office.Interop.Word.WdCaptionPosition.wdCaptionPositionAbove.GetHashCode, false)