VB6 User Selection being skipped

[LucasC]

Having some trouble with this code;

The intent is for the user to select a hole edge then generate a cylinder(GSD) normal to the support surface as a keep out zone.

It completely skips the user input(screen pick) for the edge and support surface but generates the cylinder with missing center point and surface inputs.

I'm still trying to teach myself VB so I may have missed something fundamental.



Sub CATMain(Radius, Height1, Height2)

On Error Resume Next

Dim partDocument1 As Document
Dim part1 As Part

Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part

If Err.Number = 0 Then

partDocument1.Activate

Dim Dia1 As Long
Dia1 = Radius * 2

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Add()
hybridBody1.Name = "Ø" & Dia1 & "mm Socket Clearance"

partDocument1.Activate

Dim sel2 As Selection
Set sel2 = part1.Selection

If sel2.Count > 0 Then
sel2.Clear
End If

Dim Sel2lb 'as selection 'declare as a variant, not as a Selection (for selectelement2)

Dim InputObjectType1(3), UserInput1
InputObjectType1(0) = "BiDimFeatEdge"
InputObjectType1(1) = "TriDimFeatEdge"
InputObjectType1(2) = "HybridShapeCurveExplicit"
InputObjectType1(3) = "Vertex"

Set Sel2lb = sel2 'late bound sel2

UserInput1 = Sel2lb.SelectElement2(InputObjectType1(), ">>>>>>>>>>>> Select circular edge <<<<<<<<<<<<", False)
If (UserInput1 = "Cancel") Then Exit Sub

Dim CircEdge1 As Object
Set CircEdge1 = Sel2lb.Item(1).Reference

partDocument1.Activate

Sel2lb.Clear

Dim sel3 As Selection
Set sel3 = part1.Selection

If sel3.Count > 0 Then
sel3.Clear
End If

Dim sel3lb 'as selection 'declare as a variant, not as a Selection (for selectelement2)

Dim InputObjectType2(0), UserInput2
InputObjectType2(0) = "BiDim"

Set sel3lb = sel3 'late bound sel3

UserInput2 = sel3lb.SelectElement2(InputObjectType2, ">>>>>>>>>>>>>> Select the support surface <<<<<<<<<<<<<<", False)
If (UserInput2 = "Cancel") Then Exit Sub

Dim Surf1
Set Surf1 = sel3lb.Item(1).Reference

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(CircEdge1)

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

Dim HybridShapeFactory1 As Factory
Set HybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridShapeDirection1 As HybridShapeDirection
Set hybridShapeDirection1 = HybridShapeFactory1.AddNewDirection(reference2)

Dim hybridShapeCylinder1 As HybridShapeCylinder
Set hybridShapeCylinder1 = HybridShapeFactory1.AddNewCylinder(reference1, Radius, Height1, Height2, hybridShapeDirection1)
hybridShapeCylinder1.SymmetricalExtension = 0
hybridBody1.AppendHybridShape hybridShapeCylinder1


part1.Update

Else
MsgBox "This is not a part document!"
End If

End Sub

 

[LWolf]

Dim sel2 As Selection
Set sel2 = partDocument1.Selection

selection was set on the wrong level (twice)...
when you debug your code, it is good to turn off "on Error resume Next"...
either completely, or when you are done with the particular error-event.
err.clear
on error goto 0

I took the liberty of removing some stuff from your script...
no need to dim a new Selection for instance...
I update only the created feature and not the entire part...
no need to reactivate the part time after time...

Sub CATMain(Radius, Height1, Height2)
On Error Resume Next

Dim partDocument1 As Document
Dim part1 As Part

Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part

partDocument1.Activate
if err <> 0 then
msgbox "This is not a part document!"
err.clear
exit sub
end if
on error goto 0

Dim Dia1 As Long
Dia1 = Radius * 2

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Add()
hybridBody1.name = "Ø" & Dia1 & "mm Socket Clearance"

Dim sel2 As Selection
Set sel2 = partDocument1.Selection
sel2.Clear

Dim Sel2lb 'as selection 'declare as a variant, not as a Selection (for selectelement2)

Dim InputObjectType1(3), UserInput1
InputObjectType1(0) = "BiDimFeatEdge"
InputObjectType1(1) = "TriDimFeatEdge"
InputObjectType1(2) = "HybridShapeCurveExplicit"
InputObjectType1(3) = "Vertex"

Set Sel2lb = sel2 'late bound sel2

UserInput1 = Sel2lb.SelectElement2(InputObjectType1(), ">>>>>>>>>>>> Select circular edge <<<<<<<<<<<<", False)
If (UserInput1 = "Cancel") Then Exit Sub

Dim CircEdge1 As Object
Set CircEdge1 = Sel2lb.item(1).Reference

Sel2lb.Clear

Dim InputObjectType2(0), UserInput2
InputObjectType2(0) = "BiDim"

UserInput2 = Sel2lb.SelectElement2(InputObjectType2, ">>>>>>>>>>>>>> Select the support surface <<<<<<<<<<<<<<", False)
If (UserInput2 = "Cancel") Then Exit Sub

Dim Surf1
Set Surf1 = Sel2lb.item(1).Reference

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(CircEdge1)

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

Dim HybridShapeFactory1 As Factory
Set HybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridShapeDirection1 As HybridShapeDirection
Set hybridShapeDirection1 = HybridShapeFactory1.AddNewDirection(reference2)

Dim hybridShapeCylinder1 As HybridShapeCylinder
Set hybridShapeCylinder1 = HybridShapeFactory1.AddNewCylinder(reference1, Radius, Height1, Height2, hybridShapeDirection1)
hybridShapeCylinder1.SymmetricalExtension = 0
hybridBody1.AppendHybridShape hybridShapeCylinder1


part1.UpdateObject hybridShapeCylinder1
End Sub


regards,
LWolf

 

[tesak]

Hello,
the first you can try is to uncomment On Error Resume Next line, which suppresses all errors, so you have no chance to find out what is happening.

Tesak

https://scripts4all.eu/play-tetris-in-catia-v5-drawing-vba/

- Play Tetris in CATIA V5 drawing

 

[LucasC]

Hi LWolf,

Thanks for the code clean up.

However, the user selection still is not working at all. the inputs from the parameter box make it into the cylinder fields (Radius, Height1, Height2) but the whole SelectElement2 section for the circular edge and plane seem to be skipped completely.

The code functions properly to create and rename the geoset based on the values entered.

I have used this method on other projects and it works fine for selecting edges etc. I'm stumped why it doesn't work here.



Edit: This is a separate issue but I'm wonder why I can't run some CATVBA macro's from the IDE when a parameter box is used I.E. "Sub CATMain(Param1, Param2)". At least it seems to be when I use this. When I click the play button it doesn't recognize the module. I have to switch back to CATIA and Tools>Macros>Run. And sometimes I have to use the "Select" feature to repoint to it.

 

[LucasC]

I found the typo that was the problem.


One last issue;

It's not recognizing the reference, "Reference1 = nothing"

code:

[highlight #FCE94F]Dim CircEdge1 As Object
Set CircEdge1 = Sel2.Item(1).Reference[/highlight]

...

[highlight #FCE94F] Dim Reference1 As Reference
Set Reference1 = Part1.CreateReferenceFromObject(CircEdge1)[/highlight]

Dim HybridShapeDirection1 As HybridShapeDirection
Set HybridShapeDirection1 = HybridShapeFactory1.AddNewDirection(Surf1)

Dim HybridShapeCylinder1 As HybridShapeCylinder
Set HybridShapeCylinder1 = HybridShapeFactory1.AddNewCylinder([highlight #FCE94F]Reference1[/highlight], Radius, Height1, Height2, HybridShapeDirection1)

 

[LWolf]

Dim CircEdge1 as object--- so your variable wants an object there, thus
set CircEdge1 =Sel2.item(1).Value

then you dim reference... that wants to create a reference to an object (and NOT a reference) so:
Dim Reference1 as Reference
Set Reference1 = Part1.CreateReferenceFromObject(CircEdge1) 'CircEdge1 is an object



regards,
LWolf

 

[LucasC]

With some changes I got the first selection through debug as follows. still unknown if it will accept it in the Cylinder command. I also overlooked the fact a cylinder has a point and surface/plane required as inputs So I added that.

Dim Sel2 'As Selection 'declare as a variant, not as a Selection (for selectelement2)
Set Sel2 = partDocument1.Selection
Sel2.Clear

partDocument1.Activate

Dim UserInput1

Dim InputObjectType1(4)
InputObjectType1(0) = "BiDimFeatEdge"
InputObjectType1(1) = "TriDimFeatEdge"
InputObjectType1(2) = "HybridShapeCurveExplicit"
InputObjectType1(3) = "Edge"
[highlight #8AE234]InputObjectType1(4) = "Vertex"[/highlight]

UserInput1 = Sel2.SelectElement2(InputObjectType1(), ">>>>>>>>>>>> Select circular edge <<<<<<<<<<<<", False)
If (UserInput1 = "Cancel") Then Exit Sub

[highlight #8AE234]Dim CircEdge1
Set CircEdge1 = Sel2.Item(1).Reference

Dim Pt1 As Point
Set Pt1 = part1.HybridShapeFactory.AddNewPointCenter(CircEdge1)[/highlight]




It doesn't seem to like my choice for surface selection. its returning reference2 as no value/nothing.I've tried surf1 as variant and with .reference and added in all the objects the documentation suggests. All with no luck.

Sel2.Clear

Dim UserInput2

[highlight #FCE94F] Dim InputObjectType2(3)
InputObjectType2(0) = "Face"
InputObjectType2(1) = "BiDim"
InputObjectType2(2) = "Plane"
InputObjectType2(3) = "PlanarFace"[/highlight]
'InputObjectType2(4) = "PlanarBiDim"
'InputObjectType2(5) = "PlanarBiDimInfinite"
'InputObjectType2(6) = "RectilinearTriDimFeatEdge"
'InputObjectType2(7) = "RectilinearBiDimFeatEdge"
'InputObjectType2(8) = "RectilinearMonoDimFeatEdge"


UserInput2 = Sel2.SelectElement2(InputObjectType2, ">>>>>>>>>>>>>> Select the Support Surface <<<<<<<<<<<<<<", False)
If (UserInput2 = "Cancel") Then Exit Sub

[highlight #FCE94F]Dim Surf1 As Object
Set Surf1 = Sel2.Item(1).Value[/highlight]

'================ Add Cylinder At User Defined Center Point =====================

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(Pt1)

[highlight #FCE94F]Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(Surf1)[/highlight]

Dim hybridShapeFactory1 As Factory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridShapeDirection1 As HybridShapeDirection
Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirection([highlight #FCE94F]reference2[/highlight])

Dim hybridShapeCylinder1 As HybridShapeCylinder
Set hybridShapeCylinder1 = hybridShapeFactory1.AddNewCylinder(reference1, Radius, Height1, Height2, [highlight #FCE94F]hybridShapeDirection1[/highlight])
hybridShapeCylinder1.SymmetricalExtension = 0
hybridBody1.AppendHybridShape hybridShapeCylinder1

 

[itsmyjob]

try this:

Dim reference2 As Reference
Set reference2 = sel1.Item(1).Reference

Eric N.
indocti discant et ament meminisse periti ​

 

[LucasC]

I just could not get creatreferencefromobject to work on the planar direction input, tried all sorts of solutions. The value always came back null. I even tried using a BRep Context. Eventually, I created a plane from the selected surface and used that as the object. I'm going to try and eliminate 6-8 from the array but this one is solved. Thanks for the suggestions.

Dim UserInput2

[highlight #FCE94F]Dim InputObjectType2(8)
InputObjectType2(0) = "Face"
InputObjectType2(1) = "BiDim"
InputObjectType2(2) = "Plane"
InputObjectType2(3) = "PlanarFace"
InputObjectType2(4) = "PlanarBiDim"
InputObjectType2(5) = "PlanarBiDimInfinite"
InputObjectType2(6) = "RectilinearTriDimFeatEdge"
InputObjectType2(7) = "RectilinearBiDimFeatEdge"
InputObjectType2(8) = "RectilinearMonoDimFeatEdge"[/highlight]

UserInput2 = Sel2.SelectElement2(InputObjectType2, ">>>>>>>>>>>>>> Select the Support Surface <<<<<<<<<<<<<<", False)
If (UserInput2 = "Cancel") Then Exit Sub

Dim Surf1
[highlight #FCE94F]Set Surf1 = Sel2.Item(1).Value[/highlight]

Dim PointRef1 As Reference
Set PointRef1 = Part1.CreateReferenceFromObject(Pt1)

Dim HSFactory1 As Factory
Set HSFactory1 = Part1.HybridShapeFactory

[highlight #FCE94F] Dim Plane1 As Plane
Set Plane1 = HSFactory1.AddNewPlaneOffset(Surf1, 0, 0)[/highlight]

Dim Direction1 As HybridShapeDirection
Set Direction1 = HSFactory1.AddNewDirection([highlight #FCE94F]Plane1[/highlight])

Dim Cylinder1 As HybridShapeCylinder
Set Cylinder1 = HSFactory1.AddNewCylinder(PointRef1, Radius, Height1, Height2, Direction1)
Cylinder1.SymmetricalExtension = 0
Cylinder1.Orientation = 1
HybridBody1.AppendHybridShape Cylinder1

Sel2.Clear