There is a solidworks assembly containing a point "P" and a coordinate system frame "F". The goal is to find x,y,z coordinates of the point "P" wrt the frame "F". The VB code looks like
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim bstatus As Boolean
Dim swMeasure As SldWorks.Measure
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
swModel.ClearSelection2 True
bstatus = swModel.Extension.SelectByID2("P", "DATUMPOINT", 0, 0, 0, False, 0, Nothing, 0)
Debug.Assert bstatus
Set swMeasure = swModel.Extension.CreateMeasure
bstatus = swMeasure.Calculate(Nothing)
Debug.Assert bstatus
Debug.Print ("X: " & swMeasure.X)
Debug.Print ("Y: " & swMeasure.Y)
Debug.Print ("Z: " & swMeasure.Z)
End Sub
The script works, but it gives coordinates in recently used coordinate system frame. It can be the frame "F" or the default frame, so the result is unpredictable. I couldn't find the properties of the Measure class to force it to use the necessary frame. Is there a way to explicitly specify the frame? Is there a workaround?
You can get the point coordinates like this example method, then you might need to multiply that with the matrix of the coordinate system with GetCoordinateSystemTransformByName or GetDefinition ot the Coordinate System Feature, and if the point P is in a component, you will need to multiply previous matrix with the component matrix transform Transform2.
See also this related post
Related
I've been trying to do what the title describes for over a day now and I can't seem to figure it out.
Situation:
I have a 3D part with multiple user-made parameters as string.
I create a new drawing with front, top & isometric view.
I wish to create a macro that reads the string values of the parameters of my 3D part and writes them in specific locations on the drawing.
Work so far:
I'm able to have a macro summon text to my drawing, but I can't figure out how to, while in the VB environment, extract a string value from a user-made parameter in my 3D part.
I've tried to use
myValue = material.Value
Where "material" is the parameter of my 3D part but I'm not able to get a return. I do not know what to declare and how to reference to the parameter properly.
Furthermore, I'm capable of writing plain text on my drawing with a macro by writing this:
Set myText = MyDrawingViews.ActiveView.Texts.Add("description", 22, 38)
I get a text saying "description" on my drawing in the intended location, but I can't figure out how to drive the text with a variable instead.
When I try:
dim myValue as string
myValue = "description"
Set myText = MyDrawingViews.ActiveView.Texts.Add(myValue, 22, 38)
I do not get a return.
I've been trying but I can't seem to get anywhere, any help would be greatly appreciated.
You need to get a reference to the Parameter from the Part or Product that you want in the text. Also, you should use the InsertVariable method of a DrawingText object to link a parameter. When the parameter changes in the part, it can be updated in the drawing.
Here's a simple Sub that can accomplish what you want(you can modify it to accomplish what you want more specifically):
Sub AddTextWithLinkedParameter(dViewToContainTheText As DrawingView, xPos, yPos, Optional param As Parameter)
Dim dtext As DrawingText
Set dtext = dViewToContainTheText.Texts.Add("", xPos, yPos)
If Not param Is Nothing Then
dtext.InsertVariable 0, 0, param
End If
End Sub
Here's some sample code to test it:
Sub testParameterText()
Debug.Assert False
'
'Manually Activate the Part Document
'that contains a string parameter called "Property
'
Dim myParam As Parameter
Dim partDoc As PartDocument
Set partDoc = CATIA.ActiveDocument
Set myParam = partDoc.Part.Parameters.Item("Property")
Debug.Assert False
'manually switch to a drawing document
Dim dDoc As DrawingDocument
Set dDoc = CATIA.ActiveDocument
Dim dSheet As DrawingSheet
Set dSheet = dDoc.Sheets.ActiveSheet
Dim dView As DrawingView
Set dView = dSheet.Views.Item("Main View")
AddTextWithLinkedParameter dView, 20, 20, myParam
End Sub
I wrote a macro that hides everything in several geometrical sets and the objects and geometrical sets in these first sets except one specific branch. I use this for saving a defined object of a huge and complicated specification tree as a STP file. (See attached below.)
(Small complication in this “Hide_and_Save” macro: adding bodies to my hide-selection works well but for my show-selection it didn’t work the same way. Why would this happen?)
I also wrote a macro that does iterative adjustments. For the iterations I use a Do While Loop and some parameters and measurements. To update these values, I have to update the part/object in every cycle. But there are some construction elements that issue errors until the loop is successfully completed. Therefore I deactivate all the geometrical sets that I don’t need for the iterations (inclusively all children) and later I reactivate them manually.
My goal is to improve automation, so I tried to use my “Hide_and_Save” macro for deactivation and reactivation. This didn’t work. When I record the process, each object is listed in a separate line and deactivated. Since there are more than 350 elements, I would like to avoid this.
How do I deactivate all subelements in a geometrical set (preferably with children) without addressing each element individually?
Attribute VB_Name = "Hide_and_Save"
'_______________________________________________________________________________________
'Title: Hide_and_Save
'Language: catvba
'_______________________________________________________________________________________
Sub CATMain()
'---------------------------------------------------------------------------------------
'Select active Part/Document
Dim myDocument As Document
Set myDocument = CATIA.ActiveDocument
Dim myPart As part
Set myPart = CATIA.ActiveDocument.part
'--------------------------------------------------------------
' Enter file path
Dim filepath As String
filepath = InputBox("Please select memory location", "Input filepath", "...")
If filepath = "" Then 'cancle, abort or empty input
MsgBox "No valid input / cancle !"
Exit Sub
End If
'--------------------------------------------------------------
' Hide/show Objects of Part/Products and save as STEP
' Update Model
CATIA.ActiveDocument.part.Update
' Deklaration of Selections and Properties
Dim selectionShow, selectionHide As Selection
Set selectionShow = myDocument.Selection
Set selectionHide = myDocument.Selection
Dim visPropertySetShow, visPropertySetHide As VisPropertySet
Set visPropertySetShow = selectionShow.VisProperties
Set visPropertySetHide = selectionHide.VisProperties
' Definition of the collection of geometric sets - HybridBodies
Dim hybridBodiesInPart, hybridBodiesInProcess As HybridBodies
Dim hybridBodiesInRS, hybridBodiesInHuelle As HybridBodies
' Definition of individual geometric sets - HybridBody
Dim hybridBodyInPart, hybridBodyProcess, hybridBodyInProcess As HybridBody
Dim hybridBodyRS, hybridBodyInRS As HybridBody
Dim hybridBodyHuelle, hybridBodyInHuelle As HybridBody
' Definition of the collection of 3D-objects - HybridShapes
Dim hybridShapesInHuelle As HybridShapes
' Definition of individual 3D-objects - HybridShape
Dim hybridShapeInHuelle, hybridShapeForm As HybridShape
' Hide objects
Set hybridBodiesInPart = myPart.HybridBodies
For Each hybridBodyInPart In hybridBodiesInPart
selectionHide.Add hybridBodyInPart
Next
Set hybridBodyProcess = hybridBodiesInPart.Item("Process")
Set hybridBodiesInProcess = hybridBodyProcess.HybridBodies
For Each hybridBodyInProcess In hybridBodiesInProcess
selectionHide.Add hybridBodyInProcess
Next
Set hybridBodyHuelle = hybridBodiesInProcess.Item("Huelle")
Set hybridBodiesInHuelle = hybridBodyHuelle.HybridBodies
For Each hybridBodyInHuelle In hybridBodiesInHuelle
selectionHide.Add hybridBodyInHuelle
Next
Set hybridShapesInHuelle = hybridBodyHuelle.HybridShapes
For Each hybridShapeInHuelle In hybridShapesInHuelle
selectionHide.Add hybridShapeInHuelle
Next
Set hybridShapeForm = hybridShapesInHuelle.Item("Form")
visPropertySetHide.SetShow 1 'hide
selectionHide.Clear
' Show objects
selectionShow.Add hybridBodyProcess
selectionShow.Add hybridBodyHuelle
selectionShow.Add hybridShapeForm
visPropertySetShow.SetShow 0 'show
selectionShow.Clear
' Data export as STP
stepAnswer = MsgBox("Should the displayed elements be saved as STEP?", 3 + 0, "Export: Form")
If stepAnswer = 6 Then
myDocument.ExportData filepath & "Form" & ".stp", "stp"
ElseIf stepAnswer = 3 Or stepAnswer = 2 Then 'cancle or abort
MsgBox "cancle !"
Exit Sub
End If
'---------------------------------------------------------------------------------------
MsgBox "Finished !" & vbCrLf & s
End Sub
(Usually I work with Generative Shape Design and use VBA for Macros.)
Each feature has an "Activity" parameter aggregated to it.
Dim oShape as HybridShape
For Each oShape In oGS.HybridShapes
Dim oActivity as Parameter
Set oActivity = oPart.Parameters.SubList(oShape,False).Item("Activity")
Call oActivity.ValuateFromString("False")
Next
Let me add that screwing with Activity of features is not a best practice. I NEVER do this myself. If you have access KBE (Specifically Knowledge Advisor Workbench) you can probably do what you want with Rules/Actions/Reactions, less coding and have a more robust model in the end.
I'm trying to write a VBA macro that builds a basic diagram from data and certain template shapes (held on a separate page). While I can cut and paste successfully, I seem to be unable to reference the new shape after I do this. I can relocate the shape before I cut and paste it, but if I try to do anything after the fact, I hit a run-time error. There are various reasons why I might need to move / update the objects later, so I need to be able to subsequently reference them.
My code is as follows:
Dim Shape as Visio.Shape
Dim ShapeID as Integer
‘copy shape from template page 2, ID 12
Set Shape = Application.ActiveDocument.Pages.ItemU("Page-2").Shapes.ItemFromID(12).Duplicate
ShapeID = Shape.ID
MsgBox ("Created shape ID: " & ShapeID)
'Now relocate the shape appropriately
currentX = startX + (Count * xSpacing)
currentY = startY
Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaForceU = "" & currentX & " mm"
Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaForceU = "" & currentY & " mm"
Shape.Cut
'Now go to page 1 and paste the object
Application.ActiveDocument.Pages.ItemU("Page-1").Paste
‘*** THE FOLLOWING LINE THAT DOESN’T WORK ***
Set Shape = Application.ActiveDocument.Pages.ItemU("Page-1").Shapes.ItemFromID(ShapeID)
Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaForceU = "" & currentX & " mm"
Shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaForceU = "" & currentY & " mm"
If I run the above, I get the error "Invalid sheet identifier" at the highlighted line (the shape is pasted successfully). If I cut this line out, I get "an exception occurred" on the following line, so it looks like I've lost my reference to the object.
A shape's ID is only unique to its page, so the new shape that you paste into Page-1 will receive a new ID and hence the error that you're receiving. Although the Duplicate method returns a shape reference to the new shape, Paste does not so you need to get a reference to it by other means - either assuming something about the window selection (as per Surrogate's answer) or by index:
Dim shp As Visio.Shape
Dim pag As Visio.Page
Set pag = ActivePage 'or some alternative reference to Page-1
Set shp = pag.Shapes.ItemU(pag.Shapes.Count)
Debug.Print shp.Index
A more usual workflow would be to generate masters (in a stencil document) and then drop those masters rather than copying and pasting between pages, but your scenario may require a different approach.
I'll add this link as useful reference for dealing with Index and ID properties:
Working with Shape Objects
[Update]
#Jon Fournier's comment below is quite right that the above does make assumptions. For example, if the DisplayLevel cell in the source shape is less than the top most shape then it will be pasted into the page's shapes collection at the corresponding index and so count won't return the correct shape ID.
An alternative approach might be to listen to the ShapeAdded event on Pages (or Page). The following is a slight adaption from the IsInScope example in the docs, with code placed ThisDocument. This allows you to top and tail your code in an event scope ID pair that you can inspect when handling the ShapeAdded event:
Private WithEvents vPags As Visio.Pages
Private pastedScopeID As Long
Public Sub TestCopyAndPaste()
Dim vDoc As Visio.Document
Set vDoc = Me 'assumes code is in ThisDocument class module, but change as required
Dim srcPag As Visio.Page
Set srcPag = vDoc.Pages.ItemU("Page-2")
Dim targetPag As Visio.Page
Set targetPag = vDoc.Pages.ItemU("Page-1")
Dim srcShp As Visio.Shape
Set srcShp = srcPag.Shapes.ItemFromID(12)
Set vPags = vDoc.Pages
pastedScopeID = Application.BeginUndoScope("Paste to page")
srcShp.Copy
targetPag.Paste
Application.EndUndoScope pastedScopeID, True
End Sub
Private Sub vPags_ShapeAdded(ByVal shp As IVShape)
If shp.Application.IsInScope(pastedScopeID) Then
Debug.Print "Application.CurrentScope " & Application.CurrentScope
Debug.Print "ShapeAdded - " & shp.NameID & " on page " & shp.ContainingPage.Name
DoSomethingToPastedShape shp
Else
Debug.Print "Application.CurrentScope " & Application.CurrentScope
End If
End Sub
Private Sub DoSomethingToPastedShape(ByVal shp As Visio.Shape)
If Not shp Is Nothing Then
shp.CellsU("FillForegnd").FormulaU = "=RGB(200, 30, 30)"
End If
End Sub
Of course you get error "Invalid sheet identifier" ! Because at "Page-1" you can have shape with ShapeID, which you defined for shape placed at "Page-2".
You can paste shape and after this step define selected shape.
Application.ActiveDocument.Pages.ItemU("Page-1").Paste
' You can define this variable as shape which is selected
Set Shape = Application.ActiveWindow.Selection.PrimaryItem
Why you use variable two times ?
I haven’t found a great way to handle this. I have a method that will paste the clipboard to a page and return any new shapes, by listing all shape ids before and after pasting, and then returning new shapes.
If speed is a big issue for me I’ll usually paste to an empty hidden page, do whatever I have to on that page, then cut and paste in place on the destination page. If you need to glue with other shapes this wouldn’t really work, but when it makes sense I use this logic.
Instead of Duplicate&Cut&Paste, just use Drop:
Dim srcShape, dstShape as Shape
Set srcShape = ActiveDocument.Pages("Page-2").Shapes("srcShape")
Set dstShape = ActiveDocument.Pages("Page-1").Drop(srcShape, 0, 0)
After the above you can access dstShape and do with it whatever you want.
I've been trying to do what the title describes for over a day now and I can't seem to figure it out.
Situation:
I have a 3D part with multiple user-made parameters as string.
I create a new drawing with front, top & isometric view.
I wish to create a macro that reads the string values of the parameters of my 3D part and writes them in specific locations on the drawing.
Work so far:
I'm able to have a macro summon text to my drawing, but I can't figure out how to, while in the VB environment, extract a string value from a user-made parameter in my 3D part.
I've tried to use
myValue = material.Value
Where "material" is the parameter of my 3D part but I'm not able to get a return. I do not know what to declare and how to reference to the parameter properly.
Furthermore, I'm capable of writing plain text on my drawing with a macro by writing this:
Set myText = MyDrawingViews.ActiveView.Texts.Add("description", 22, 38)
I get a text saying "description" on my drawing in the intended location, but I can't figure out how to drive the text with a variable instead.
When I try:
dim myValue as string
myValue = "description"
Set myText = MyDrawingViews.ActiveView.Texts.Add(myValue, 22, 38)
I do not get a return.
I've been trying but I can't seem to get anywhere, any help would be greatly appreciated.
You need to get a reference to the Parameter from the Part or Product that you want in the text. Also, you should use the InsertVariable method of a DrawingText object to link a parameter. When the parameter changes in the part, it can be updated in the drawing.
Here's a simple Sub that can accomplish what you want(you can modify it to accomplish what you want more specifically):
Sub AddTextWithLinkedParameter(dViewToContainTheText As DrawingView, xPos, yPos, Optional param As Parameter)
Dim dtext As DrawingText
Set dtext = dViewToContainTheText.Texts.Add("", xPos, yPos)
If Not param Is Nothing Then
dtext.InsertVariable 0, 0, param
End If
End Sub
Here's some sample code to test it:
Sub testParameterText()
Debug.Assert False
'
'Manually Activate the Part Document
'that contains a string parameter called "Property
'
Dim myParam As Parameter
Dim partDoc As PartDocument
Set partDoc = CATIA.ActiveDocument
Set myParam = partDoc.Part.Parameters.Item("Property")
Debug.Assert False
'manually switch to a drawing document
Dim dDoc As DrawingDocument
Set dDoc = CATIA.ActiveDocument
Dim dSheet As DrawingSheet
Set dSheet = dDoc.Sheets.ActiveSheet
Dim dView As DrawingView
Set dView = dSheet.Views.Item("Main View")
AddTextWithLinkedParameter dView, 20, 20, myParam
End Sub
.addPicture requires width and height, but this could end up distorting the image. Is there any way to use .LockAspectRatio = msoCTrue when adding the file image?
Also, how do you stipulate a page to put the canvas or the picture? Macro recorder needs to be stopped before one can work on images somehow.
Set sCanvas = ActiveDocument.Shapes _
.AddCanvas(Left:=MillimetersToPoints(20), Top:=MillimetersToPoints(20), _
Width:=300, Height:=200)
Set CanvasShapes = sCanvas.CanvasItems
With CanvasShapes
.AddPicture FileName:="C:\somepath\image.png", _
Left:=0, Top:=0, Width:=150, Height:=100
...
End With
Set the canvas size to 0 and lock it's aspect ratio, then add the picture. The canvas will scale to accommodate it. After the image is loaded, then scale the canvas as needed:
Set sCanvas = ActiveDocument.Shapes.AddCanvas(MillimetersToPoints(20), MillimetersToPoints(20), 0, 0)
sCanvas.LockAspectRatio = True
Set CanvasShapes = sCanvas.CanvasItems
With CanvasShapes
.AddPicture "C:\somepath\image.png"
End With
'Scale the canvas here.
You could try to obtain the dimensions using the code here (pasted below for reference)
Sub test()
Dim objShell As Object
Dim objFolder As Object
Dim objFile As Object
Dim fPath As Variant 'MUST be a variant, not a string
Dim fName As String
fPath = "C:\somepath"
fName = "image.png"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(fPath)
Set objFile = objFolder.ParseName(fName)
MsgBox objFile.ExtendedProperty("Dimensions")
End Sub
This will give you the dimensions of the picture which you can then use.
It looks like the output is ? w x h ? so you'll need to parse it, but this should work.
Note that if you want to use a variable to define the file path, it must be declared as a variant, per here
If you check the definition of the AddPicture method you will find that except for FileName all of the arguments are optional, so Height and Width are not required.
Unless you have a specific reason for adding a canvas it is also unnecessary to add a canvas before adding a picture.
Word has no concept of pages so you cannot specify that the picture should appear on a certain page.
Managed to find a way to put a picture to a specific page (page 2 in example below) in MS Word:
Dim pNum as long
pNum = 2
Selection.GoTo What:=wdGoToPage, Count:= pNum