Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

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

Creating Plane 1

Status
Not open for further replies.

yamaCad

Mechanical
Joined
Jan 12, 2025
Messages
15
Location
Turkey
I'm trying create a plane from selected axis but I'm missing something so It can' create it. I record a macro for this but it takes like axis2 how can I get my axis selected? Because I'm not work with main axis. After selecting axis macro will create plane from selected axis. Or can start from xy direction or z direction of selected axis.

Recorded is like this:

Code:
Language="VBSCRIPT"

Sub CATMain()

Set partDocument1 = CATIA.ActiveDocument

Set part1 = partDocument1.Part

Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim axisSystem1
' No resolution found for the object axisSystem1...

Set reference1 = part1.CreateReferenceFromBRepName("RSur:(Face:(Brp:(AxisSystem.2;1);None:();Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", axisSystem1)

Set hybridShapePlaneOffset1 = hybridShapeFactory1.AddNewPlaneOffset(reference1, 20.000000, False)

Set hybridBodies1 = part1.HybridBodies

Set hybridBody1 = hybridBodies1.Item("kesme_celigi")

hybridBody1.AppendHybridShape hybridShapePlaneOffset1

part1.InWorkObject = hybridShapePlaneOffset1

part1.Update

End Sub

Here is my code:

Code:
Sub CATMain()

    Dim partDoc
    Set partDoc = CATIA.ActiveDocument

    Dim part
    Set part = partDoc.Part

    Dim hsf
    Set hsf = part.HybridBodies

    Dim geomSet
    Set geomSet = hsf.Add()
    geomSet.Name = "kesme_celigi"

    Dim selection
    Set selection = partDoc.Selection
    MsgBox "select axis"
    
    Dim status
    status = selection.SelectElement2(Array("AnyObject"), "select", False)

    If status = "Normal" Then
        Dim selectedAxis
        Set selectedAxis = selection.Item(1).Value


        If TypeName(selectedAxis) = "AxisSystem" Then
            Dim factory
            Set factory = part.HybridShapeFactory

            Dim xyPlane
            Set xyPlane = factory.AddNewPlaneExplicit(selectedAxis.GetItem("XY Plane"))

            geomSet.AppendHybridShape xyPlane
            part.Update
        Else
            MsgBox "select axis"
        End If
    Else
        MsgBox "selection canceled"
    End If
End Sub
 
this code assumes you have already selected your AxisSystem. I retrieve all the info from this axis system (origo, axis coordinates) and create two lines that will span the plane.

Code:
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 sel
Set sel = CATIA.ActiveDocument.Selection

Dim axiscoord(2)
Dim originCoord(2)
Dim axissyst

Set axissyst = sel.item(1).Value
 
Dim originpoint, hybridShapeD1, hybridShapeD2, hybridShapeD3
axissyst.GetOrigin originCoord
Set originpoint = hybridShapeFactory1.AddNewPointCoord(originCoord(0), originCoord(1), originCoord(2))

axissyst.GetXAxis axiscoord
Set hybridShapeD1 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))
axissyst.GetYAxis axiscoord
Set hybridShapeD2 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))
axissyst.GetZAxis axiscoord
Set hybridShapeD3 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))

Dim Plane_line_1 As HybridShapeLinePtDir
Set Plane_line_1 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD1, 0, 10, False)
Dim Plane_line_2 As HybridShapeLinePtDir
Set Plane_line_2 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD2, 0, 10, False)

Dim myXYPlane As Plane
Set myXYPlane = hybridShapeFactory1.AddNewPlane2Lines(Plane_line_1, Plane_line_2)
part1.HybridBodies.item(3).AppendHybridShape myXYPlane
part1.UpdateObject myXYPlane

End Sub
 
this code assumes you have already selected your AxisSystem. I retrieve all the info from this axis system (origo, axis coordinates) and create two lines that will span the plane.

Code:
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 sel
Set sel = CATIA.ActiveDocument.Selection

Dim axiscoord(2)
Dim originCoord(2)
Dim axissyst

Set axissyst = sel.item(1).Value
 
Dim originpoint, hybridShapeD1, hybridShapeD2, hybridShapeD3
axissyst.GetOrigin originCoord
Set originpoint = hybridShapeFactory1.AddNewPointCoord(originCoord(0), originCoord(1), originCoord(2))

axissyst.GetXAxis axiscoord
Set hybridShapeD1 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))
axissyst.GetYAxis axiscoord
Set hybridShapeD2 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))
axissyst.GetZAxis axiscoord
Set hybridShapeD3 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))

Dim Plane_line_1 As HybridShapeLinePtDir
Set Plane_line_1 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD1, 0, 10, False)
Dim Plane_line_2 As HybridShapeLinePtDir
Set Plane_line_2 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD2, 0, 10, False)

Dim myXYPlane As Plane
Set myXYPlane = hybridShapeFactory1.AddNewPlane2Lines(Plane_line_1, Plane_line_2)
part1.HybridBodies.item(3).AppendHybridShape myXYPlane
part1.UpdateObject myXYPlane

End Sub
Thank you Lwolf Now I'm at work I will try tonight. Is this possible from selecting of my custom axis xy_plane. In your code are you select axis or plane?
 
this code assumes you have already selected your AxisSystem. I retrieve all the info from this axis system (origo, axis coordinates) and create two lines that will span the plane.

Code:
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 sel
Set sel = CATIA.ActiveDocument.Selection

Dim axiscoord(2)
Dim originCoord(2)
Dim axissyst

Set axissyst = sel.item(1).Value
 
Dim originpoint, hybridShapeD1, hybridShapeD2, hybridShapeD3
axissyst.GetOrigin originCoord
Set originpoint = hybridShapeFactory1.AddNewPointCoord(originCoord(0), originCoord(1), originCoord(2))

axissyst.GetXAxis axiscoord
Set hybridShapeD1 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))
axissyst.GetYAxis axiscoord
Set hybridShapeD2 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))
axissyst.GetZAxis axiscoord
Set hybridShapeD3 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))

Dim Plane_line_1 As HybridShapeLinePtDir
Set Plane_line_1 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD1, 0, 10, False)
Dim Plane_line_2 As HybridShapeLinePtDir
Set Plane_line_2 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD2, 0, 10, False)

Dim myXYPlane As Plane
Set myXYPlane = hybridShapeFactory1.AddNewPlane2Lines(Plane_line_1, Plane_line_2)
part1.HybridBodies.item(3).AppendHybridShape myXYPlane
part1.UpdateObject myXYPlane

End Sub
Hello LWolf.

Your code didn't worked on me I think because of my version. It's R21.

But I get the idea and I changed a little bit.

Here is my code and it works perfectly.

Thank you :)

Code:
Sub CATMain()

    Dim partDocument1
    Set partDocument1 = CATIA.ActiveDocument

    Dim part1
    Set part1 = partDocument1.part

    Dim hybridShapeFactory1
    Set hybridShapeFactory1 = part1.HybridShapeFactory

    Dim sel
    Set sel = CATIA.ActiveDocument.Selection

    Dim status
    status = sel.SelectElement2(Array("AxisSystem"), "Select an axis", False)

    If status <> "Normal" Then
        MsgBox "Axis not selected. Macro canceled."
        Exit Sub
    End If

    Dim axissyst
    Set axissyst = sel.Item(1).Value

    Dim axiscoord(2)
    Dim originCoord(2)
    Dim originpoint
    Dim hybridShapeD1
    Dim hybridShapeD2
    Dim hybridShapeD3

    axissyst.GetOrigin originCoord
    Set originpoint = hybridShapeFactory1.AddNewPointCoord(originCoord(0)-0.5, originCoord(1), originCoord(2))

    axissyst.GetXAxis axiscoord
    Set hybridShapeD1 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))
    axissyst.GetYAxis axiscoord
    Set hybridShapeD2 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))
    axissyst.GetZAxis axiscoord
    Set hybridShapeD3 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))

    Dim Plane_line_1
    Dim Plane_line_2
    Set Plane_line_1 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD1, 0, 1, False)
    Set Plane_line_2 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD2, 0, 1, False)

    Dim myXYPlane
    Set myXYPlane = hybridShapeFactory1.AddNewPlane2Lines(Plane_line_1, Plane_line_2)

    Dim targetHybridBody

    If part1.HybridBodies.Count = 0 Then
        Set targetHybridBody = part1.HybridBodies.Add()
        targetHybridBody.Name = "YeniHybridBody"
    Else

        Set targetHybridBody = part1.HybridBodies.Item(1)
    End If

    targetHybridBody.AppendHybridShape myXYPlane

    part1.UpdateObject myXYPlane

End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top