×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Renaming and Line creation

Renaming and Line creation

Renaming and Line creation

(OP)
Hi Guys,
I'm trying to create a script to put a point in the centre of a hole then create a line from that relative to a planer face.
I have found some code that creates the first point and I've managed to alter it a little to send the point to a chosen geo set and also rename it.
I can't figure out how to get the rename to add a instance number like catia does when creating the points ie Point.1, Point.2 etc.
Does anyone know how to do this ?
After that I need to create a line.
I have found some commands from Automation V5 but how you put thim in to practice I don't know. I'm searching the web looking for a relative example.
Any help on either things would be really appreciated.

code below (whoever wrote that and shared, many thanks)

regards
Alan

---------------------------------------------------------------------------------------------------------------------------------------

Sub CATMain()

Set oDoc = CATIA.ActiveDocument
Set oPart = oDoc.Part

Dim reference1 'As Reference

Set oHSF = oPart.HybridShapeFactory

Dim InputObject(0)
InputObject(0) = "Edge"

Set oCentre = CATIA.ActiveDocument.Selection
Status = oCentre.SelectElement2(InputObject, "Select Circle", False)

Set oTemp = oCentre.Item(1)

Set oRef = oTemp.Reference

Set oPoint = oHSF.AddNewPointCenter(oRef)

'Set oHB = oPart.HybridBodies.Add() 'Will add a new Geometrical Set for each Point
Set oHB = oPart.HybridBodies.Item("Points") 'Sends to named Geo Set

oPoint.Name = "Hole Centre" &intIndex'+(oNo-1) ' Can't get this bit to rename in sequence :(

oPoint.Compute

oHB.AppendHybridShape oPoint

End Sub



' Found this in Automation V5

'Dim oSurface As Reference
'Set oSurface = LineNormal.Surface

'Dim oPoint As Reference
'Set oPoint = LineNormal.Point

'Dim oOrientation As long
'Set oOrientation = LineNormal.Orientation

'Dim oEnd As CATIALength
'Set oEnd = LineNormal.EndOffset

'Dim oStart As CATIALength
'Set oStart = LineNormal.BeginOffset

RE: Renaming and Line creation

Hi Alan,
in your code you have a lot of undeclared variables, so no wonder it is not working properly. To get the next number in a sequence, just read the CATIA generated name of the current point, get the index and then change your name as you need. You can read the index only when the point already exists in the tree, so put the following code below this line:

...
oHB.AppendHybridShape oPoint

CODE --> VBA

Dim nextIndex As Long
nextIndex = CLng(Split(oPoint.Name, ".")(1))
oPoint.Name = "Hole Centre." & nextIndex 

Tesak
https://scripts4all.eu/play-tetris-in-catia-v5-dra... - Play Tetris in CATIA V5 drawing

RE: Renaming and Line creation

(OP)
Thanks tesak
really appreciated :)

RE: Renaming and Line creation

(OP)
Hi again,
I have managed to get this Frankenstein code that I have botched together from other code to run in the way I wanted.
Run the script, select the edge of a hole then select the face.
I just creates a point and a line normal to the face 50mm long and renames the point and line.
Problem is that it only works at part level.
LWolf kindly gave me some code to do this for another macro.

Dim oPartProduct As Product
Dim oPartDocument As Document
Dim oPart As Part
For Each oPartProduct In product1.Products
Set oPartDocument = oPartProduct.ReferenceProduct.Parent
Set oPart = oPartDocument.Part

No mater how I apply it, it won't work on the script im working on.
Any help would be really welcome.

regards
Alan.

------------------------------------------------------------------------------------
Sub CATMain()

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

Dim hybridShapeFactory1 'As Factory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridBodies1 'As HybridBodies
Set hybridBodies1 = part1.HybridBodies

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

Dim hybridShapes1 'As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

Dim selection1 'As Selection
Set selection1 = partDocument1.Selection
selection1.Clear

Dim reference1 'As Reference
Dim oPart
Set oPart = part1

Dim oHSF
Set oHSF = oPart.HybridShapeFactory

Dim InputObject(0)
InputObject(0) = "Edge"

Dim oCentre
Set oCentre = CATIA.ActiveDocument.Selection
Status = oCentre.SelectElement2(InputObject, "Select Circle", False)

Dim oTemp
Set oTemp = oCentre.Item(1)

Dim oRef
Set oRef = oTemp.Reference

Dim oPoint
Set oPoint = oHSF.AddNewPointCenter(oRef)

Dim oHB
'Set oHB = oPart.HybridBodies.Add() 'Will add a new Geometrical Set for each Point
Set oHB = oPart.HybridBodies.Item("Points")

oPoint.Compute

oHB.AppendHybridShape oPoint

Dim nextIndex
nextIndex = CLng(Split(oPoint.Name, ".")(1))
oPoint.Name = "Hole Centre." & nextIndex

Set reference1 = oPoint

selection1.Clear

Dim InputObjectType(0), Status1
InputObjectType(0)="Face"
Status1=selection1.SelectElement2(InputObjectType,"Select Face",false)
If Status1 = "Cancel" Then selection1.Clear: Exit Sub

Dim reference2 'As Reference
Set reference2 = selection1.Item(1).Reference

Dim hybridShapeLineNormal
Set hybridShapeLineNormal = hybridShapeFactory1.AddNewLineNormal(reference2, reference1, 0.000000, 50.000000, True)

hybridBody1.AppendHybridShape hybridShapeLineNormal

part1.InWorkObject = hybridShapeLineNormal

Dim nextIndex1
nextIndex1 = CLng(Split(hybridShapeLineNormal.Name, ".")(1))
hybridShapeLineNormal.Name = "Vector." & nextIndex

part1.Update

End Sub
----------------------------------------------------------------

RE: Renaming and Line creation

Alan... this really is a FrankenCode... afro2

I did not bother changing it too much, just made it work for you. However:
it only takes in a straight part-structure, i.e. a product with a bunch of parts right under.
AND it only does ONE hole in each part bigsmile
(this will be your homework to make it more general, both in terms of number of holes, AND a more nested part/sub-assy structure)
you also assume there is a geometrical set called Points right under part-node.

have fun! tongue

Sub CATMain()
Dim product1 As Product
Set product1 = CATIA.ActiveDocument.Product
Dim oPartProduct As Product
Dim oPartDocument As Document
Dim part1 As Part

For Each oPartProduct In product1.Products
Set oPartDocument = oPartProduct.ReferenceProduct.Parent
Set part1 = oPartDocument.Part

Dim hybridBodies1 'As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 'As HybridBody
Set hybridBody1 = hybridBodies1.item(1)
Dim hybridShapes1 'As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

Dim oHSF
Set oHSF = part1.HybridShapeFactory
Dim InputObject(0)
InputObject(0) = "Edge"
Dim mySel
Set mySel = CATIA.ActiveDocument.Selection
Status = mySel.SelectElement2(InputObject, "Select Circle", False)

Dim oTemp
Set oTemp = mySel.item(1)

Dim oRef
Set oRef = oTemp.Reference

Dim oPoint
Set oPoint = oHSF.AddNewPointCenter(oRef)

Dim oHB

Set oHB = part1.HybridBodies.item("Points")

oPoint.Compute

oHB.AppendHybridShape oPoint

Dim nextIndex
nextIndex = CLng(Split(oPoint.name, ".")(1))
oPoint.name = "Hole Centre." & nextIndex

Set reference1 = oPoint

mySel.Clear

Dim InputObjectType(0), Status1
InputObjectType(0) = "Face"
Status1 = mySel.SelectElement2(InputObjectType, "Select Face", False)
If Status1 = "Cancel" Then mySel.Clear: Exit Sub

Dim reference2 'As Reference
Set reference2 = mySel.item(1).Reference

Dim hybridShapeLineNormal
Set hybridShapeLineNormal = oHSF.AddNewLineNormal(reference2, reference1, 0#, 50#, True)

hybridBody1.AppendHybridShape hybridShapeLineNormal

part1.InWorkObject = hybridShapeLineNormal

Dim nextIndex1
nextIndex1 = CLng(Split(hybridShapeLineNormal.name, ".")(1))
hybridShapeLineNormal.name = "Vector." & nextIndex

part1.Update

Next

End Sub

regards,
LWolf

RE: Renaming and Line creation

(OP)
Thanks LWolf,
I shall have a go at tidying it up over the weekend and try and work out how to get multiple holes and more nested structure.
I know it is a botch up but when I swapped around the references on line-
Set hybridShapeLineNormal = oHSF.AddNewLineNormal(reference2, reference1, 0#, 50#, True)
and the line popped up, I was jumping about like an idiot :)

Could you point me in the direction of any material that explains some of the main the functions etc.
I have the V5 scripting course but find some of it doesn't go into detail on why things are done in a certain way.
I also find the V5 Automation hard to follow and to find things.
I'm not looking for freebies, this is something I need to learn and not having a programming background I'm starting from scratch.

anyway,
thanks again
Alan

RE: Renaming and Line creation

(OP)
LWolf,
I couldn't get that code to run. I'm probably doing something totally wrong lol
I think I have messed up from the start though.
My idea was to have an assembly open, create a part called Data or something and create a geo set in there called Points.
I then wanted to run the macro at assembly level to create the points and vectors in the Data.part/Points Geo-set.
If I save my assembly as an AllCatPart it works a treat and I can copy the Data.Part back into my original assembly. so at a pinch it's usable on small assemblies.
Anyway I've tried to clean it up a bit and renamed some items to try and get my head around what there doing.

thanks
Alan

---------------------------------------------------------------------------------------------------

Sub CATMain()

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

Dim hybridShapeFactory1 'As Factory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridBodies1 'As HybridBodies
Set hybridBodies1 = part1.HybridBodies

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

Dim hybridShapes1 'As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

Dim selection1 'As Selection
Set selection1 = partDocument1.Selection

'------------------------------Select Hole Centre & Create Point---------------------
Dim InputObject1(0)
InputObject1(0) = "Edge"
Dim oCentreSelection
Set oCentreSelection = CATIA.ActiveDocument.Selection
Status = oCentreSelection.SelectElement2(InputObject1, "Select Circle", False)
Dim oCentreItem
Set oCentreItem = oCentreSelection.Item(1)
Dim oCentreRef
Set oCentreRef = oCentreItem.Reference
Dim oCentrePoint
Set oCentrePoint = hybridShapeFactory1.AddNewPointCenter(oCentreRef)
hybridBody1.AppendHybridShape oCentrePoint

'-----------------------------Select Face & Create Vector----------------------------
Dim InputObject2(0)
InputObject2(0)= "Face"
Dim oFaceSelection
Set oFaceSelection = CATIA.ActiveDocument.Selection
Status=oFaceSelection.SelectElement2(InputObject2,"Select Face",false)
Dim oFaceItem
Set oFaceItem = oFaceSelection.Item(1)
Dim oFaceRef
Set oFaceRef = oFaceItem.Reference
Dim oVector
Set oVector = hybridShapeFactory1.AddNewLineNormal(oFaceRef, oCentrePoint, 0.000000, 50.000000, True)
hybridBody1.AppendHybridShape oVector

'----------------------------Rename-------------------------------------------------
Dim nextIndex
nextIndex = CLng(Split(oCentrePoint.Name, ".")(1))
oCentrePoint.Name = "Hole Centre." & nextIndex

Dim nextIndex1
nextIndex1 = CLng(Split(oVector.Name, ".")(1))
oVector.Name = "Vector." & nextIndex

selection1.Clear
part1.Update

End Sub

RE: Renaming and Line creation

(OP)
Hi guys
Could anyone help me with this last problem.
I have got the code to run a product level but the part wont update due to no reference element being created when the point is.
It creates the point and line in a an active part (first geo-set)

any help on this would be really appreciated as I can't find anything relevant on line.

regards
Alan

'-----------------------------------------------------------------------------------------------

Sub CATMain()

Dim InputObject1(0)
Dim oCentreSelection
Dim oCentreItem
Dim oCentreRef
Dim oCentrePoint
Dim InputObject2(0)
Dim oFaceSelection
Dim oFaceItem
Dim oFaceRef
Dim oVector

'Do

Dim part1
Set partDocument1 = CATIA.ActiveDocument.Product.Products.Item(1).ReferenceProduct.Parent

Set part1 = partDocument1.Part

Dim hybridShapeFactory1 'As Factory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridBodies1 'As HybridBodies
Set hybridBodies1 = part1.HybridBodies

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

Dim hybridShapes1 'As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

Dim selection1 'As Selection
Set selection1 = partDocument1.Selection

'------------------------------Select Hole Edge & Create Point---------------------

InputObject1(0) = "Edge"
Set oCentreSelection = CATIA.ActiveDocument.Selection
Status = oCentreSelection.SelectElement2(InputObject1, "Select Circle", False)
Set oCentreItem = oCentreSelection.Item(1)
Set oCentreRef = oCentreItem.Reference
Set oCentrePoint = hybridShapeFactory1.AddNewPointCenter(oCentreRef)
hybridBody1.AppendHybridShape oCentrePoint

'-----------------------------Select Face & Create Vector----------------------------

InputObject2(0)= "Face"

Set oFaceSelection = CATIA.ActiveDocument.Selection
Status=oFaceSelection.SelectElement2(InputObject2,"Select Face",false)
Set oFaceItem = oFaceSelection.Item(1)
Set oFaceRef = oFaceItem.Reference
Set oVector = hybridShapeFactory1.AddNewLineNormal(oFaceRef, oCentrePoint, 0.000000, 50.000000, True)
hybridBody1.AppendHybridShape oVector

selection1.Clear

part1.Update

'Loop (will sort this later)

End Sub

RE: Renaming and Line creation

here you go. works as script and in vba. commented what I removed...

Sub CATMain()

Dim InputObject1(0)
Dim oCentreSelection
Dim oCentreItem
'Dim oCentreRef 'LWolf removed
Dim oCentrePoint
Dim InputObject2(0)
Dim oFaceSelection
Dim oFaceItem
'Dim oFaceRef 'LWolf removed
Dim oVector

'Do

Dim part1
Set partDocument1 = CATIA.ActiveDocument.Product.Products.item(1).ReferenceProduct.Parent

Set part1 = partDocument1.Part

Dim hybridShapeFactory1 'As Factory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridBodies1 'As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 'As HybridBody
Set hybridBody1 = hybridBodies1.item(1)

Dim hybridShapes1 'As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

'------------------------------Select Hole Edge & Create Point---------------------

InputObject1(0) = "Edge"
Set oCentreSelection = CATIA.ActiveDocument.Selection
Status = oCentreSelection.SelectElement2(InputObject1, "Select Circle", False)
Set oCentreItem = oCentreSelection.item(1).value 'LWolf added .value
'Set oCentreRef = oCentreItem.Reference 'LWolf removed
Set oCentrePoint = hybridShapeFactory1.AddNewPointCenter(oCentreItem)
hybridBody1.AppendHybridShape oCentrePoint

'-----------------------------Select Face & Create Vector----------------------------

InputObject2(0) = "Face"

Set oFaceSelection = CATIA.ActiveDocument.Selection
Status = oFaceSelection.SelectElement2(InputObject2, "Select Face", False)
Set oFaceItem = oFaceSelection.item(1).value 'LWolf added .value
'Set oFaceRef = oFaceItem.Reference 'LWolf removed
Set oVector = hybridShapeFactory1.AddNewLineNormal(oFaceItem, oCentrePoint, 0, 50, True)
hybridBody1.AppendHybridShape oVector

part1.Update

'Loop (will sort this later)

End Sub

regards,
LWolf

RE: Renaming and Line creation

Alan, just curious, what do you want the point and line for?... you ask for two inputs, if you go with axis, you just ask for one...

regards,
LWolf

RE: Renaming and Line creation

(OP)
Hi LWolf,
The code is to add a vector from the hole centre 50mm long. On the line are 2 points one at 25 and one at 50.
These points are named OTP and will be used for laser tracking.
This is something that I usually have to do one at a time and can be a real pain.
I have used the same steps to create it in a macro as I would do manually so there could well be an easier option.
Another bit of code I got a while back searches the geo-set for OTP and renames them in order 1, 2, 3 etc
Some companies have a macro that then add them point positions to a table on a drawing. Unfortuanely I haven't got that as it only runs on a machine that it has been installed on.
If I can get this to work my next project is a table macro?
I have removed the naming for the first point and line as it wasn't really needed.
I need a way to get the support elements into the collector geo-set so it will update, I can then have a go at the loop.

cheers
Alan

ps Is the line
Set partDocument1 = CATIA.ActiveDocument.Product.Products.Item(1).ReferenceProduct.Parent
the correct way to work at product level ?

RE: Renaming and Line creation

(OP)
Sorry
Forgot to add the code :)

Sub CATMain()

Dim InputObject1(0)
Dim oCentreSelection
Dim oCentreItem
Dim oCentreRef
Dim oCentrePoint
Dim InputObject2(0)
Dim oFaceSelection
Dim oFaceItem
Dim oFaceRef
Dim oVector


Do


Dim part1
'Set partDocument1 = CATIA.ActiveDocument 'Part Level
Set partDocument1 = CATIA.ActiveDocument.Product.Products.Item(1).ReferenceProduct.Parent 'Product Level

Set part1 = partDocument1.Part

Dim hybridShapeFactory1 'As Factory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridBodies1 'As HybridBodies
Set hybridBodies1 = part1.HybridBodies

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

Dim hybridShapes1 'As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

Dim selection1 'As Selection
Set selection1 = partDocument1.Selection

'------------------------------Select Hole Centre & Create Point---------------------
'Dim InputObject1(0)
InputObject1(0) = "Edge"
'Dim oCentreSelection
Set oCentreSelection = CATIA.ActiveDocument.Selection
Status = oCentreSelection.SelectElement2(InputObject1, "Select Circle", False)
'Dim oCentreItem
Set oCentreItem = oCentreSelection.Item(1)
'Dim oCentreRef
Set oCentreRef = oCentreItem.Reference
'Dim oCentrePoint
Set oCentrePoint = hybridShapeFactory1.AddNewPointCenter(oCentreRef)
hybridBody1.AppendHybridShape oCentrePoint

'-----------------------------Select Face & Create Vector----------------------------
'Dim InputObject2(0)
InputObject2(0)= "Face"
'Dim oFaceSelection
Set oFaceSelection = CATIA.ActiveDocument.Selection
Status=oFaceSelection.SelectElement2(InputObject2,"Select Face",false)
'Dim oFaceItem
Set oFaceItem = oFaceSelection.Item(1)
'Dim oFaceRef
Set oFaceRef = oFaceItem.Reference
'Dim oVector
Set oVector = hybridShapeFactory1.AddNewLineNormal(oFaceRef, oCentrePoint, 0.000000, 50.000000, True)
hybridBody1.AppendHybridShape oVector

Set oPoint25 = hybridShapeFactory1.AddNewPointOnCurveFromDistance(oVector, 25.000000, False) 'Point at 25mm
oPoint25.DistanceType = 1
hybridBody1.AppendHybridShape oPoint25

Set oPoint50 = hybridShapeFactory1.AddNewPointOnCurveFromDistance(oVector, 0.000000, False) 'Point at 50mm - end of Vector
oPoint50.DistanceType = 1
hybridBody1.AppendHybridShape oPoint50

'----------------------------Rename-------------------------------------------------

oPoint25.Name = "OTP"

oPoint50.Name = "OTP"

selection1.Clear

part1.Update

Loop

End Sub

RE: Renaming and Line creation

Alan, this was fun... here, try this:
just copy the code and run on your assy...
see if you can figure it out, perhaps you need some tweaking to get your 50mm lines :)

Sub CATMain()

Dim oManuName
oManuName = 3 'InputBox("Enter Screw size M?")

Dim holeDia
Dim holeHDAngle
Dim holeHDDepth
Dim holeName
If oManuName = 3 Then holeDia = 3.5
If oManuName = 3 Then holeHDAngle = 90
If oManuName = 3 Then holeHDDepth = 1.86
If oManuName = 3 Then holeName = "C/Sunk Hole for M3 CSHS"

Dim product1 As Product
Set product1 = CATIA.ActiveDocument.Product
Dim oSelection
Set oSelection = CATIA.ActiveDocument.Selection
oSelection.Clear

Dim oPart As Part
oSelection.Clear
oSelection.Search "Type=Hole,all"

Dim hole1 As Object

For i = 1 To oSelection.count
Set hole1 = oSelection.item(i).Value
reDim myAxisCoordinate(8)
hole1.Sketch.GetAbsoluteAxisData myAxisCoordinate
OriginX = myAxisCoordinate(0)
OriginY = myAxisCoordinate(1)
OriginZ = myAxisCoordinate(2)
HorizontalX = myAxisCoordinate(3)
HorizontalY = myAxisCoordinate(4)
HorizontalZ = myAxisCoordinate(5)
VerticalX = myAxisCoordinate(6)
VerticalY = myAxisCoordinate(7)
VerticalZ = myAxisCoordinate(8)
reDim H(2) 'As Double
reDim V(2) 'As Double
H(0) = HorizontalX
H(1) = HorizontalY
H(2) = HorizontalZ
V(0) = VerticalX
V(1) = VerticalY
V(2) = VerticalZ
Dim zAxis
zAxis = CrossProd(H, V)

Set oPart = GetPartFromObject(hole1)
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = oPart.HybridShapeFactory
Dim hybridShapeDirection1 As HybridShapeDirection
Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirectionByCoord(zAxis(0), zAxis(1), zAxis(2))
Dim hybridShapeLinePtDir1 As HybridShapeLinePtDir
Set hybridShapeLinePtDir1 = hybridShapeFactory1.AddNewLinePtDir(hole1.Sketch.AbsoluteAxis.Origin, hybridShapeDirection1, -0, 20, False)

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = oPart.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.item(1)

hybridBody1.AppendHybridShape hybridShapeLinePtDir1
hole1.name = holeName & "." & i
oPart.Update
Next

oSelection.Clear

End Sub

Public Function CrossProd(V1, V2) 'As Double()
Dim Res() 'As Double
ReDim Res(2)
Res(0) = V1(1) * V2(2) - V1(2) * V2(1)
Res(1) = V1(2) * V2(0) - V1(0) * V2(2)
Res(2) = V1(0) * V2(1) - V1(1) * V2(0)
CrossProd = Res
Erase Res
End Function

Private Function GetPartFromObject(ByRef iObject As Object) As Part
Dim strTypeName As String
strTypeName = TypeName(iObject)

If strTypeName = "Part" Then
Set GetPartFromObject = iObject
Exit Function
ElseIf strType = TypeName(iObject.Parent) Then
Set GetPartFromObject = Nothing
Exit Function
Else
Set GetPartFromObject = GetPartFromObject(iObject.Parent)
End If
End Function

regards,
LWolf

RE: Renaming and Line creation

(OP)
Wow, is that what it should have looked like.
I thought I was doing so well lolz
It’s a big learning curve.

Really have appreciated your help

Regards
Alan

RE: Renaming and Line creation

(OP)
Hi LWolf,
I couldn't get the code to run but I think I see what you mean.
Using your method give the point a reference where my approach didn't.
It would have been nice to have it all linked to the selected hole in case anything was moved. An update request would make me check everything was ok.
I might try and create a curve on the hole edge to help spot if anything has moved. Would stand out more than just the line and points.
Couldn't find a way to isolate the point and tried AddPointDatum but couldn't get either to work :(
I shall have a go with what you sent.

and it isn't fun lol :)

thanks & best regards
Alan

RE: Renaming and Line creation

I tried the code as CATScript and inserted in VBA, both worked without any mishaps...
I have an assy with 3parts containing pads with random holes...
how is it not working?... anybody out there, could you pls. try to run the code?

regards,
LWolf

RE: Renaming and Line creation

(OP)
Hi,
I have tried it again this morning on my work machine and it still drops out at
Private Function GetPartFromObject(ByRef iObject As Object) As Part
:(
cheers
Alan

RE: Renaming and Line creation

(OP)
Used the dodgy part level code this morning.
Made an AllCatPart of the assy, Battered of 40 plus points and copied them back over to the original assy.
Renamed and made the table.
Took about 20 min. Would have took 1 or 2 hours before so happy as a pig in ****.
Lost all links but it still counts as a win :)
Quite like these macro'y things lol

cheers LWolf & tesak

RE: Renaming and Line creation

(OP)
Hi Guys,

Tried to get the code to run by trying to get the coordinates but got nowhere.
This line just wont work and I keep getting errors " hole1.Sketch.GetAbsoluteAxisData myAxisCoordinate "

Can anyone tell me how I can isolate the points in my original code so it will work in a product ?
Getting desperate lol

cheers
Alan

RE: Renaming and Line creation

I would perhaps try to change the line

CODE --> VBA

reDim myAxisCoordinate(8) 
to

CODE --> VBA

Dim myAxisCoordinate(8) 

First one returns a dynamic array, a second one static array, which could make a difference in the end.

Tesak
https://scripts4all.eu/play-tetris-in-catia-v5-dra... - Play Tetris in CATIA V5 drawing

RE: Renaming and Line creation

(OP)
Thanks Tesak
Tried it but it still fails at the same line. :(
hole1.Sketch.GetAbsoluteAxisData myAxisCoordinate

I'm not after selecting all the holes, I just need to select them one at a time, first the edge then the face and create the line.
The original script I botched up is fine at part level but won't update at product level.
Is there anyway for me to isolate the first point or extract it's coordinates without executing the 'hybridBody1.AppendHybridShape oCentrePoint' line.
I could then use the coordinates to make the line.
I've tried using -

vHole.GetOrigin (origin)
Msgbox "Origin = " & origin(0) & ", " & origin(1) & ", " & origin(2)

that I found online but that doesn't work either lol

cheers anyway :)
Alan




RE: Renaming and Line creation

I think you should post the latest version of your code because definitely, you are doing something wrong. Script from LWolf works really good, so the problem is somewhere on your side.

Tesak
https://scripts4all.eu/play-tetris-in-catia-v5-dra... - Play Tetris in CATIA V5 drawing

RE: Renaming and Line creation

(OP)
LWolfs code works and creates the lines great but they are in each parts geo-set.
I need all the lines to be created in a selected 'collector' parts geo-set.
I think this is where i'm having the problem.
I can get the points and lines in the selected geo-set but they wont update once there in there.

or is it me being thick ?

thanks for the help
Alan

RE: Renaming and Line creation

(OP)
That makes sense :)
The code i'm playing about with is below.
My thinking was to create a point using the method that worked in my original code but not use line 'hybridBody1.AppendHybridShape oCentrePoint'.
I was then trying to create a new Line using the coordinates from "oCentrePoint" hoping it would create a link.

I'm probably going about this in totally the wrong way lol

cheers
Alan

-----------------------------------------------------------------------------------------------------------------------------------------------

Sub CATMain()

Dim InputObject1(0)
Dim oCentreSelection
Dim oCentreItem
Dim oCentreRef
Dim oCentrePoint
Dim InputObject2(0)
Dim oFaceSelection
Dim oFaceItem
Dim oFaceRef
Dim oVector


Do


Dim part1
'Set partDocument1 = CATIA.ActiveDocument 'Part Level
Dim partDocument1
Set partDocument1 = CATIA.ActiveDocument.Product.Products.Item(1).ReferenceProduct.Parent 'Product Level


Set part1 = partDocument1.Part

Dim hybridShapeFactory1 'As Factory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridBodies1 'As HybridBodies
Set hybridBodies1 = part1.HybridBodies

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

Dim hybridShapes1 'As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

Dim selection1 'As Selection
Set selection1 = partDocument1.Selection

'------------------------------Select Hole Centre & Create Point---------------------

InputObject1(0) = "Edge"

Set oCentreSelection = CATIA.ActiveDocument.Selection
Status = oCentreSelection.SelectElement2(InputObject1, "Select Circle", False)

Set oCentreItem = oCentreSelection.Item(1)

Set oCentreRef = oCentreItem.Reference

Set oCentrePoint = hybridShapeFactory1.AddNewPointCenter(oCentreRef)

'hybridBody1.AppendHybridShape oCentrePoint

'------------------------------------------------------------------------------------

Dim hole1 'As Object

Set hole1 = oCentrePoint
reDim myAxisCoordinate(8)
hole1.Sketch.GetAbsoluteAxisData myAxisCoordinate ' This is as far as it goes
OriginX = myAxisCoordinate(0)
OriginY = myAxisCoordinate(1)
OriginZ = myAxisCoordinate(2)
HorizontalX = myAxisCoordinate(3)
HorizontalY = myAxisCoordinate(4)
HorizontalZ = myAxisCoordinate(5)
VerticalX = myAxisCoordinate(6)
VerticalY = myAxisCoordinate(7)
VerticalZ = myAxisCoordinate(8)
reDim H(2) 'As Double
reDim V(2) 'As Double
H(0) = HorizontalX
H(1) = HorizontalY
H(2) = HorizontalZ
V(0) = VerticalX
V(1) = VerticalY
V(2) = VerticalZ
Dim zAxis
zAxis = CrossProd(H, V)

Set oPart = GetPartFromObject(hole1)
Set hybridShapeFactory1 = oPart.HybridShapeFactory
Dim hybridShapeDirection1 'As HybridShapeDirection
Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirectionByCoord(zAxis(0), zAxis(1), zAxis(2))
Dim hybridShapeLinePtDir1 'As HybridShapeLinePtDir
Set hybridShapeLinePtDir1 = hybridShapeFactory1.AddNewLinePtDir(hole1.Sketch.AbsoluteAxis.Origin, hybridShapeDirection1, -0, 20, False)

Set hybridBodies1 = oPart.HybridBodies

Set hybridBody1 = hybridBodies1.item(1)

hybridBody1.AppendHybridShape hybridShapeLinePtDir1


'-----------------------------Select Face & Create Vector---------------------------- not using at the moment

'InputObject2(0)= "Face"

'Set oFaceSelection = CATIA.ActiveDocument.Selection
'Status=oFaceSelection.SelectElement2(InputObject2,"Select Face",false)

'Set oFaceItem = oFaceSelection.Item(1)

'Set oFaceRef = oFaceItem.Reference

'Set oVector = hybridShapeFactory1.AddNewLineNormal(oFaceRef, oCentrePoint, 0.000000, 50.000000, True)
'hybridBody1.AppendHybridShape oVector

'Set oPoint25 = hybridShapeFactory1.AddNewPointOnCurveFromDistance(oVector, 25.000000, False) 'Point at 25mm
'oPoint25.DistanceType = 1
'hybridBody1.AppendHybridShape oPoint25

'Set oPoint50 = hybridShapeFactory1.AddNewPointOnCurveFromDistance(oVector, 0.000000, False) 'Point at 50mm - end of Vector
'oPoint50.DistanceType = 1
'hybridBody1.AppendHybridShape oPoint50

'----------------------------------------------------------------------------------------------------------



'----------------------------Rename-------------------------------------------------

'oPoint25.Name = "OTP"

'oPoint50.Name = "OTP"


selection1.Clear

part1.Update

Loop

End Sub

RE: Renaming and Line creation

Hi Alan,
your code is a "real" mess :). I do not understand an infinite Do ... Loop around the whole procedure. As I see it, the reason why its is not working by you is the simple fact that you use it on holes which are not the "real" CATIA Hole features, but probably holes drilled with pockets. The code from LWolf is applicable only on "real" CATIA holes.

Tesak
https://scripts4all.eu/play-tetris-in-catia-v5-dra... - Play Tetris in CATIA V5 drawing

RE: Renaming and Line creation

(OP)
Hi tesak
Ye I know it’s a mess lol
It was done to save me a lot of mouse clicks on some work I’m doing, not really meant to be an example of how to program :)
The holes I’m working ( was working on, finished now ) are created using the hole function in Catia. There not pockets.
LWolfs code works perfectly but creates lines on every hole.
The fixture had hundreds of holes in it, I only need to select about 40 so I couldn’t use that.
I ended up making an allcatpart and used my original code then copied the points back to my product. It worked but broken links :(
I just don’t understand why catia isn’t creating the reference geometry when I create the points.
Usually you can’t stop catia doing that?
It would be nice to get it working for next t8me though.

Cheers for the help
Alan

RE: Renaming and Line creation

Hi Alan,
in your code you are mixing pears and apples. In this part of the code you assign HybridShapePointCenter point into a oCentrePoint variable and then you assign this center point to a hole1 variable. The variable hole1 is meant to be a Hole object. In fact, you are calling Sketch.GetAbsoluteAxisData on a point (HybridShapePointCenter) object, not on the Hole object as expected, so no wonder that you get an error message. Do not expect that methods of the Hole object will be applicable to the Point object as these are completely different entities.

And then, without even posting your code, you want us to give you an explanation, why the hell it is not working. Really, you have to give us all the details, otherwise, do not expect answers.

CODE --> VBA

Set oCentrePoint = hybridShapeFactory1.AddNewPointCenter(oCentreRef)

'hybridBody1.AppendHybridShape oCentrePoint

'------------------------------------------------------------------------------------

Dim hole1 'As Object

Set hole1 = oCentrePoint
reDim myAxisCoordinate(8)
hole1.Sketch.GetAbsoluteAxisData myAxisCoordinate ' This is as far as it goes 

Tesak
https://scripts4all.eu/play-tetris-in-catia-v5-dra... - Play Tetris in CATIA V5 drawing

RE: Renaming and Line creation

(OP)
Hi tesak,

I don't do this for a living and have no formal training, I'm trying to learn how to do little snippets of code that will help me do the job I do.
If I don't ask I won't learn.
I had no idea that the hole1 variable was supposed to be a hole object so I've learned something that I didn't know, so for that thankyou.

I didn't post the last code as the question I asked was about the original code (already posted) that wasn't allowing me to update the part.
I really do appreciate any help that you and other members of this forum have given me, it has helped me to produce some bits of code that I use everyday and that save me a lot of time.

But.
There's no need to be nasty, the last line of your post is patronizing.
You also had to learn this at some point in your life so give people a chance to mess up without trying to knock them down.
We are all engineers here and most will have experience and expertise in one field or another.
I personally wouldn't be arrogant with someone who asked for my help with something they didn't know, because at one time, I didn't know either.


thanks for the help
Alan


RE: Renaming and Line creation

Sorry, I really didn't want to sound arrogant, I just wanted to point out to the fact, that you have to always give us all details, otherwise you are just loosing your and our time. From your post, I have had an impression that the original code from LWolf is not working, because of the snippet you posted. But in fact, you were referring to an error in your version of the code, that nobody has ever seen before. This is then really just a source of confusion and time wasting. We could have saved at least 5 posts if you had published your version of the code right below your question.
But anyway, sorry, I didn't mean to be rude.

Tesak
https://scripts4all.eu/play-tetris-in-catia-v5-dra... - Play Tetris in CATIA V5 drawing

RE: Renaming and Line creation

(OP)
Don’t worry about it.
I totally get your point. :)

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources

3D Scanning in the Automotive Industry
With over 100 years of production history, the automotive industry has been at the forefront of manufacturing technology since its inception. Whether the transformative technology of the day was the assembly line, the integration of robotics into the manufacturing process, or the switch from steel to aluminum frame chasses, the automotive industry has consistently implemented advanced technology into its manufacturing and production workflow to improve manufacturing and product performance. Today, the same is true. Download Now
Green light on lidar: Developing low cost systems for autonomous vehicles
Lidar has been around for quite some time, but to date, it’s been custom—and expensive. Right now, there isn’t a clear-cut solution that’s suitable for all applications, such as lidar in autonomous vehicles. As they explore options, optical and mechanical engineers are forced to make choices and tradeoffs during the design process. Download Now

Close Box

Join Eng-Tips® Today!

Join your peers on the Internet's largest technical engineering professional community.
It's easy to join and it's free.

Here's Why Members Love Eng-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close