Macro to create cylinders from excel

[George777]

Hi all,

I'm new at this forum but i hope you can help me. I know and find MACROS to import a cloud of points from excel to CATIA but now, I'm looking to create one using the vector info and create cylinders in each of this points but i dont find the way to do it (I Attach a file with an example i would like to have).

The info I have is the following (each info in columns on EXCEL):
location: [X=4916,90237451072,Y=-192,194829540374,Z=1241,98301660094]
weld vector: [I=0,707106781186547,J=0,K=-0,707106781186547]

Thanks for your time and i will appreciate all you help and comments

 

[itsmyjob]

your 2 points XYZ, IJK define a vector, you should be able to build geometry with that (like 2 points and a line defined by those 2 points) but if you need a cylinder, you need another info like the radius of the cylinder.

Eric N.
indocti discant et ament meminisse periti ​

 

[itsmyjob]

post your code and where you have problem so we can help.

Eric N.
indocti discant et ament meminisse periti ​

 

[George777]

The radius of the cylinder can be fixed by 8 mm for example to have a fixed variable. I would like to combine this two codes to automatic export from excel to CATIA:

1st:

Sub CreationPoint()

'Get CATIA
Dim PtDoc As Object
Set PtDoc = GetCATIAPartDocument

' Get the HybridBody
Dim myHBody As Object
Set myHBody = PtDoc.Part.HybridBodies.Item("GeometryFromExcel")

Dim iLigne As Integer
Dim iValid As Integer
Dim X As Double
Dim Y As Double
Dim Z As Double
Dim Point As Object

iLigne = 1
'Analyze file
While iValid <> Cst_iEND
'Read a line
ChainAnalysis iLigne, X, Y, Z, iValid
iLigne = iLigne + 1

'Not on a startcurve or endcurve -> valid point
If (iValid = 0) Then
Set Point = PtDoc.Part.HybridShapeFactory.AddNewPointCoord(X, Y, Z)
myHBody.AppendHybridShape Point
End If
Wend

'Model update
PtDoc.Part.Update
End Sub

2nd
Sub CATMain()

Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("FASTENING POINTS")

Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

Dim hybridShapePointOnCurve1 As HybridShape
Set hybridShapePointOnCurve1 = hybridShapes1.Item("CENTER_PT")

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

Dim hybridShapeFactory1 As Factory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim parameters1 As Parameters
Set parameters1 = part1.Parameters

Dim hybridShapeLineExplicit1 As Parameter
Set hybridShapeLineExplicit1 = parameters1.Item("CENTER LINE")

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

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

Dim hybridShapeCylinder1 As HybridShapeCylinder
Set hybridShapeCylinder1 = hybridShapeFactory1.AddNewCylinder(reference1, 27.000000, 40.000000, 40.000000, hybridShapeDirection1)

hybridShapeCylinder1.SymmetricalExtension = 0

Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies1.Item("FASTENING DATA")

hybridBody2.AppendHybridShape hybridShapeCylinder1

part1.InWorkObject = hybridShapeCylinder1

part1.Update

End Sub

THANKS for your time!!!!

 

[itsmyjob]

if the code #1 is working, it will create only the XYZ points, you need to modify it to read also the second IJK point from XL and create it.

Once that is done you should focus on merging the cylinder construction into your code.

Eric N.
indocti discant et ament meminisse periti ​

 

[George777]

I do my best but i can't get what I want. I attach the Excel file i have done. All help will be appreciate.
To test the macro, you have to get CATIA open with a part and a Geometrical Set and run the macro called Main and press 1 to run point creation.

It's a personal modification from the default excel ElementsFromExcel of CATIA

 

[itsmyjob]

i suggest you run your script step by step and check variables definition/value to understand what is going on.

you will see that the function to read XYZ does not read IJK...

Eric N.
indocti discant et ament meminisse periti ​

 

[George777]

Thanks for your advise. I think now I read IJK variables. The problem now is here:

ChainAnalysis iLigne, X, Y, Z, I, J, K, iValid
iLigne = iLigne + 1

The function ChainAnalysis do not works properly and my code stops here. I attach again my xls with the modifications I have done.

Thanks for your support!!

 

[itsmyjob]

you did not change the declaration of ChainAnalysis

[b]Sub ChainAnalysis(ByRef iRang As Integer, ByRef X As Double, ByRef Y As Double, ByRef Z As Double, ByRef iValid As Integer)[/b]
    Dim Chain As String
    Dim Chain2 As String
    Dim Chain3 As String
    
    Chain = GetCellA(iRang)[highlight #AD7FA8][/highlight]
    
    Select Case Chain
        Case Cst_strSTARTCurve
            iValid = Cst_iSTARTCurve
        Case Cst_strENDCurve
            iValid = Cst_iENDCurve
        Case Cst_strSTARTLoft
            iValid = Cst_iSTARTLoft
        Case Cst_strENDLoft
            iValid = Cst_iENDLoft
        Case Cst_strSTARTCoord
            iValid = Cst_iSTARTCoord
        Case Cst_strENDCoord
            iValid = Cst_iENDCoord
        Case Cst_strEND
            iValid = Cst_iEND
        Case Else
            iValid = 0
    End Select
    If (iValid <> 0) Then
        Exit Sub
    End If
    
    
    
[highlight #AD7FA8]    'Conversion string -> double
    Chain2 = GetCellB(iRang)
    Chain3 = GetCellC(iRang)
    If ((Len(Chain) > 0) And (Len(Chain2) > 0) And (Len(Chain3) > 0)) Then
        X = CDbl(Chain)
        Y = CDbl(Chain2)
        Z = CDbl(Chain3)
    Else
        iValid = Cst_iERRORCool
        X = 0#
        Y = 0#
        Z = 0#
    End If[/highlight]
End Sub

the Sub line is talking about XYZ and not IJK... Also the[highlight #AD7FA8] bottom of the sub[/highlight] does not do anything about IJK

Eric N.
indocti discant et ament meminisse periti ​

 

[George777]

Thanks for your help. I find the problem and solve it. I think i'm closer to achive this macro. Now my problemm starts on the second phase of the project:

[highlight #FCE94F]Dim part1 As Part
Set part1 = partDocument1.Part
[/highlight]
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("FASTENING POINTS")

Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

Dim hybridShapePointOnCurve1 As HybridShape
Set hybridShapePointOnCurve1 = hybridShapes1.Item(X, Y, Z)

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

Dim hybridShapeFactory1 As Factory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim parameters1 As Parameters
Set parameters1 = part1.Parameters

Dim hybridShapeLineExplicit1 As Parameter
Set hybridShapeLineExplicit1 = parameters1.Item("CENTER LINE")

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

Dim hybridShapeDirection1 As HybridShapeDirection
Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirection(I, J, K)

Dim hybridShapeCylinder1 As HybridShapeCylinder
Set hybridShapeCylinder1 = hybridShapeFactory1.AddNewCylinder(reference1, 8#, 40#, 40#, hybridShapeDirection1)

hybridShapeCylinder1.SymmetricalExtension = 0

Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies1.Item("[URL unfurl="true"]http://www.eng-tips.com/viewthread.cfm?qid=420453FASTENING[/URL] DATA")

hybridBody2.AppendHybridShape hybridShapeCylinder1

part1.InWorkObject = hybridShapeCylinder1

part1.Update

I have an error since the first line .

 

[itsmyjob]

first you have

'Get CATIA
Dim PtDoc As Object
Set [b]PtDoc[/b] = GetCATIAPartDocument

then

Dim part1 As Part
Set part1 = [b]partDocument1[/b].Part

Eric N.
indocti discant et ament meminisse periti ​

 

[George777]

I'm going to change it and test step by step to check my next issue. As you can see it's my first time trying to change a macro. I really appreciate all your support.

 

[itsmyjob]

Please share your code when you done so other will learn...

Eric N.
indocti discant et ament meminisse periti ​