Breaking link/extract with VBA 1

[pKayy]

Hey guys,

Quick question. Not familiar with the syntax used to break the link (isolate) of a part or surface, or extract a selected surface. Here's a little summary of what I want.

We go through a lot of revisions at our shop. Whenever an updated design comes in, we must extract all old, critical bodies/surfaces and isolate them as "OLD". I'm not 100% sure which method would be the best to implement this, but I am just thinking of a simple macro to run at the beginning of a revision.

Any help is appreciated.

Cheers,

 

[drewmumaw]

@pKayy
To create isolated geometry you'll probably use hybridShapeFactory1.AddNewSurfaceDatum(reference2) and hybridShapeFactory1.DeleteObjectForDatum reference2

The difficult part will be getting the macro to automatically select all of the necessary geometry that will be "OLD".

I would suggest recording a macro of yourself clicking the "create datum button", selecting, and extracting geometry and then reviewing the code. Here's the code I got:

Sub CATMain()

Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")

Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

Dim hybridShapeExtrude1 As HybridShapeExtrude
Set hybridShapeExtrude1 = hybridShapes1.Item("Extrude.1")

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromBRepName("RSur:(Face:(Brp:(GSMExtrude.1;0:(Brp:(Sketch.1;1)));None:();Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", hybridShapeExtrude1)

Dim hybridShapeExtract1 As HybridShapeExtract
Set hybridShapeExtract1 = hybridShapeFactory1.AddNewExtract(reference1)

hybridShapeExtract1.PropagationType = 3

hybridShapeExtract1.ComplementaryExtract = False

hybridShapeExtract1.IsFederated = True

hybridBody1.AppendHybridShape hybridShapeExtract1

part1.InWorkObject = hybridShapeExtract1

part1.Update

Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(hybridShapeExtract1)

Dim hybridShapeSurfaceExplicit1 As HybridShapeSurfaceExplicit
Set hybridShapeSurfaceExplicit1 = hybridShapeFactory1.AddNewSurfaceDatum(reference2)

hybridBody1.AppendHybridShape hybridShapeSurfaceExplicit1

part1.InWorkObject = hybridShapeSurfaceExplicit1

part1.Update

hybridShapeFactory1.DeleteObjectForDatum reference2

End Sub

Drew Mumaw

http://www.textsketcher.com

http://www.drewmumaw.com

 

[pKayy]

This is good, I can work with this.

I will probably ask for user input at the beginning of the macro to select the necessary bodies/surfaces (should only be ~3 bodies/surfaces).

Anyways, I will give this a shot during the week when I have some free time. Will update soon.

Thanks Drew.

 

[JeniaL]

why do you store old geometry in a new file? before revising why not to copy old file to archive? in this way you'll keep all the history.
think about several updates with a lot of old data.the file will be heavy for loading especially if you have several revised files in an assy.

 

[pKayy]

@JeniaL

We do not save the old geometry into a new file, we just embed them into a geometric set within the part file. However, I agree that we should have a separate archive for our older designs... Unfortunately, management isn't willing to deviate from our standards.

 

[JeniaL]

ask your configuration control dept/management what is a reason for that. with a small assemblies this may work. but this will never in aerospace.

 

[ferdo]

Hi,

I would ask why not a PLM/PDM system....

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

- Romania

https://picasaweb.google.com/103462806772634246699/

- EU

 

[pKayy]

Yeah... it bothers me that we don't have a full PLM system integrated. I do know however that it is in the works for the future.

Thanks for the help/suggestions guys.

 

[pKayy]

Thank you everyone for your help. I was able to revise the code to get it to work for my needs.

Here is the code for anyone else that wishes to accomplish something similar.

Sub CATMain()

Dim partDocument1
Set partDocument1 = CATIA.ActiveDocument

Dim part1
Set part1 = partDocument1.Part

Dim hybridShapeFactory1
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim bodies1
Set bodies1 = part1.Bodies

Dim Selection, Selection2
Set Selection = partDocument1.Selection

Dim partDocument2
Set partDocument2 = CATIA.ActiveDocument
Set Selection2 = partDocument2.Selection

Selection.Clear

Dim InputObjectType(0), Status, Status2

InputObjectType(0) = "Body"
	Status = Selection.SelectElement2(InputObjectType, "Select a feature", true)
	if (Status = "Cancel") then Exit Sub

Dim body1
Set body1 = Selection.Item(1).Value

Dim reference1
Set reference1 = part1.CreateReferenceFromBRepName("RSur:(Face:(Brp:(Pad.1;1);None:();Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", body1)

Dim hybridShapeExtract1
Set hybridShapeExtract1 = hybridShapeFactory1.AddNewExtract(reference1)

hybridShapeExtract1.PropagationType = 1

hybridShapeExtract1.ComplementaryExtract = False

hybridShapeExtract1.IsFederated = False

InputObjectType(0) = "HybridBody"
	Status2 = Selection2.SelectElement2(InputObjectType, "Select a feature", true)
	if (Status2 = "Cancel") then Exit Sub

Dim hybridBody1
Set hybridBody1 = Selection2.Item(1).Value

hybridBody1.AppendHybridShape hybridShapeExtract1

part1.InWorkObject = hybridShapeExtract1

part1.Update

Dim reference2
Set reference2 = part1.CreateReferenceFromObject (hybridShapeExtract1)

Dim hybridShapeSurfaceExplicit1
Set hybridShapeSurfaceExplicit1 = hybridShapeFactory1.AddNewSurfaceDatum(reference2)

hybridBody1.AppendHybridShape hybridShapeSurfaceExplicit1

part1.InWorkObject = hybridShapeSurfaceExplicit1

part1.Update

hybridShapeFactory1.DeleteObjectForDatum (reference2)

End Sub

Thanks again guys!

 

[itsmyjob]

your line

Set reference1 = part1.CreateReferenceFromBRepName("RSur:(Face:(Brp:(Pad.1;1) [...]

will fail if the solid does not have a Pad.1 feature

You could avoid this problem with the following solution:

Either you select the body like you do, then you search for face in the body and use the first one to make extract.
Or you allow user to select face only, and retrieve the Body from the selection (if face is not from solid feature then tell user to try again)

The first option seems easier to put in place.

Eric N.
indocti discant et ament meminisse periti ​

 

[pKayy]

To be honest, I have no idea what that parameter is trying to say to me... I got this off "Record Macro".

Would I replace the (Pad.1;1) with some variable that is set to the first face in my selected body? Just unfamiliar with the syntax.

Cheers,

EDIT: If you could actually explain that whole line to me. I have no idea what it means...

 

[pKayy]

bump

 

[ferdo]

Hi,

The idea is to do something which can be used anywhere, without depending on specific names or features. So, when you select a face on a feature (maybe using SelectElement2 with InputObjectType) , make it reference1, then extract, then do the extract reference(2) again and use AddNewSurfaceDatum(reference2)

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

- Romania

https://picasaweb.google.com/103462806772634246699/

- EU

 

[pKayy]

Ahh okay, I will just replace the whole line with something else. Will update when I get it working. Thanks again ferdo!

 

[itsmyjob]

This line is creating a Reference (used for the extract) from a face of the solid. The problem if that you use the BREP def to get the face. This BREP def will not work with all solid.

BREP... the can of worms of CATIA programing.​

That's why i suggested you change your script to select the solid, then search the first face and extract a surface from it. So you avoid being dependent of the BREP definition of the solid.

If you search the face you will not be dependent of the solid BREP. Search all face of a solid will always give you at least 1 face.

Eric N.
indocti discant et ament meminisse periti ​

 

[pKayy]

Got the macro working now I believe... So far it is allowing me to create extracts regardless of their naming (the issue I was encountering before).

Here is the code...

'Macro for creation of "Old Revision" references - Written by: P. Kim
'================================================================

Option Explicit	'forces variable declaration

Language="VBSCRIPT"

Sub CATMain()

msgbox ("This macro is to be used on part file only, not product.")

'Declare and set variables
Dim partDocument1
Set partDocument1 = CATIA.ActiveDocument

Dim part1
Set part1 = partDocument1.Part

Dim hybridShapeFactory1
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridBodies1
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1, geoCount, i

Dim bodies1
Set bodies1 = part1.Bodies

Dim Selection, Selection2
Set Selection = partDocument1.Selection

Dim partDocument2
Set partDocument2 = CATIA.ActiveDocument
Set Selection2 = partDocument2.Selection

Selection.Clear

'-----Code Starts Here-----


'check if existing "Old" geo set
geoCount = 0

For i = 1 to hybridBodies1.Count
	hybridBodies1.Item(i)
		If hybridBodies1.Item(i).Name = "Old" Then
			geoCount = 1
			Exit For
		End If
Next

If geoCount = 0 Then
	Set hybridBody1 = hybridBodies1.Add()
	hybridBody1.Name = "Old"
End If


Dim InputObjectType(0), Status, Status2

'ask for input (body to be referenced)'
msgbox ("Please select the body to reference.")

InputObjectType(0) = "Body"
	Status = Selection.SelectElement2(InputObjectType, "Select a feature", true)
	if (Status = "Cancel") then Exit Sub

Dim body1
Set body1 = Selection.Item(1).Value

msgbox body1.Name

'create new reference of "body1" (selected body above)'
Dim reference1
Set reference1 = part1.CreateReferenceFromObject (body1)
msgbox reference1.Name

Dim hybridShapeExtract1
Set hybridShapeExtract1 = hybridShapeFactory1.AddNewExtract(reference1)

hybridShapeExtract1.PropagationType = 1

hybridShapeExtract1.ComplementaryExtract = False

hybridShapeExtract1.IsFederated = False

'set geo set for extract to reside in
Set hybridBody1 = hybridBodies1.Item("Old")

'create extract'
hybridBody1.AppendHybridShape hybridShapeExtract1

'part1.InWorkObject = hybridShapeExtract1

part1.Update

Dim reference2
Set reference2 = part1.CreateReferenceFromObject (hybridShapeExtract1)

Dim hybridShapeSurfaceExplicit1
Set hybridShapeSurfaceExplicit1 = hybridShapeFactory1.AddNewSurfaceDatum(reference2)

'create extract (with history)
hybridBody1.AppendHybridShape hybridShapeSurfaceExplicit1

part1.InWorkObject = hybridShapeSurfaceExplicit1

part1.Update

'isolate linked extract
hybridShapeFactory1.DeleteObjectForDatum (reference2)

Dim visProperties1, SelectedElements
Set SelectedElements = partDocument1.Selection
Set visProperties1 = SelectedElements.VisProperties
SelectedElements.Clear()
SelectedElements.Add(hybridBody1)

'change colour of extract to "red"
visProperties1.SetRealColor 255,0,0,1

'change opacity of extract to 0
visProperties1.SetRealOpacity 0,1

SelectedElements.Clear()

part1.Update

End Sub

I didn't follow the exact steps that ferdo and itsmyjob explained, but that will come when I have more time. This will just be temporary until I can perfect it.

Thanks again for all the help guys. Such a great community.

EDIT: Code due to some colouring errors.

 

[ferdo]

Are you sure your code is working? It seems for me is not working.

Anyway, just another advice...don't use red color, is used by CATIA by default for not updated parts, in many companies this color is not allowed to be used because of this.

This criteria (fault criteria) is also included in other software used for checks (like Q-checker). Usually is good to adapt your code to your companies rules.

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

- Romania

https://picasaweb.google.com/103462806772634246699/

- EU

 

[pKayy]

@ferdo

I've tried it on many different work examples, and seems to be fine now. I will be tweaking the code later on to optimize it. Any specific lines that you see causing issues?

 

[ferdo]

Hi,

You are right, actually is working. I don't know why first time it didn't work for me, maybe it was a wrong copy-paste...

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

- Romania

https://picasaweb.google.com/103462806772634246699/

- EU