Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

VB6 User Selection being skipped

Status
Not open for further replies.

LucasC

Automotive
Feb 18, 2019
157
US
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
 
Replies continue below

Recommended for you

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
 
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.
 
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)
 
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
 
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




 
try this:

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

Eric N.
indocti discant et ament meminisse periti
 
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
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top